View Single Post
 
Old 03-30-2023, 05:41 AM
NoSparks NoSparks is offline Windows 10 Office 2010
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 831
NoSparks is just really niceNoSparks is just really niceNoSparks is just really niceNoSparks is just really niceNoSparks is just really nice
Default

Try this
Code:
Sub CopyData()    'Both Workbooks MUST be open when running the macro.
  Dim wb1 As Workbook
  Dim wb2 As Workbook
  Dim ws1 As Worksheet
  Dim cel As Range
  Dim MyRng As Range
  Dim i As Long
  Dim lrow As Long
  
  Set wb1 = Workbooks("Test - v1 (2023-03-27).xlsm")    'Source
  Set wb2 = Workbooks("Test (no macros) - v1.xlsx")     'Destination
  Set ws1 = wb2.Sheets("Sheet1")                        'Destination Sheet1
  i = 3                                                 'First row to copy to
  
  With wb1.Worksheets("Sheet1")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    Set MyRng = .Range(.Cells(3, 1), .Cells(lrow, 1))
    For Each cel In MyRng
      If cel <> "" Then
        ws1.Range("A" & i) = cel
        ws1.Range("B" & i) = cel.Offset(0, 1)
        'ws1.Range("C" & i) = cel.Offset(0, 2)  'Column C not included as this is a formula
        ws1.Range("D" & i) = cel.Offset(0, 3)
        ws1.Range("E" & i) = cel.Offset(0, 4)
        ws1.Range("F" & i) = cel.Offset(0, 5)
        ws1.Range("G" & i) = cel.Offset(0, 6)
        ws1.Range("H" & i) = cel.Offset(0, 7)
        ws1.Range("I" & i) = cel.Offset(0, 8)
        ws1.Range("J" & i) = cel.Offset(0, 9)
        ws1.Range("K" & i) = cel.Offset(0, 10)
        i = i + 1
      End If
    Next cel
  End With
End Sub
Reply With Quote