Switch between Workbooks, Loop through sheets and copy ranges-CodePudding

I need help one last time, code below works fine; it copies values (A1) from sheets that is in array to a new created sheet in org file. The last modyfication I want to make here, is that in this NOT_ORG file I want to copy range of values, rather than 1 value. This range always starts from A7, but the number of cols and rows might change. I want to copy this range dynamically and paste in in range(a1) in newly created sheet. I know that I should calculate lastRow & lastCol, but not sure where to put this code, and how to modify this last copy line to achieve this result.

Tagging @faneduru as he helped me initially.

Sub Test1()

  Dim lastRow As Long
  Dim WshtNames As Variant
  Dim WshtNameCrnt As Variant
  Dim WB1 As Workbook
  Dim WB2 As Workbook
  Set WB1 = ActiveWorkbook
  Set WB2 = Workbooks.Open("C:\NOT_ORG.xlsx")

  WshtNames = Array("2", "3")
  For Each WshtNameCrnt In WshtNames
    WB1.Sheets.Add.Name = WshtNameCrnt & "_new"
    WB2.Worksheets(WshtNameCrnt).Range("A1").Copy ActiveSheet.Range("A1")
  Next WshtNameCrnt

End Sub

Thanks in advance. eM

CodePudding user response：

Please, test the next code:

Sub Test1()
  Dim lastRow As Long, lastCol As Long, WshtNames, WshtNameCrnt
  Dim WB1 As Workbook, WB2 As Workbook, ws As Worksheet
  
  Set WB1 = ActiveWorkbook
  Set WB2 = Workbooks.Open("C:\NOT_ORG.xlsx")

  WshtNames = Array("2", "3")
  For Each WshtNameCrnt In WshtNames
    WB1.Sheets.Add.Name = WshtNameCrnt & "_new"
    Set ws = WB2.Worksheets(WshtNameCrnt)
    lastRow = ws.Range("A" & ws.rows.count).End(xlUp).row
    lastCol = ws.cells(7, ws.Columns.count).End(xlToLeft).Column
    ws.Range(ws.Range("A" & 7), ws.cells(lastRow, lastCol)).Copy ActiveSheet.Range("A1")
  Next WshtNameCrnt
End Sub

And a faster version, using an array:

Sub Test1Array()
  Dim lastRow As Long, lastCol As Long, WshtNames, WshtNameCrnt
  Dim WB1 As Workbook, WB2 As Workbook, ws As Worksheet, arr
  
  Set WB1 = ActiveWorkbook
  Set WB2 = Workbooks.Open("C:\NOT_ORG.xlsx")

  WshtNames = Array("2", "3")
  For Each WshtNameCrnt In WshtNames
    WB1.Sheets.Add.Name = WshtNameCrnt & "_new"
    Set ws = WB2.Worksheets(WshtNameCrnt)
    lastRow = ws.Range("A" & ws.rows.count).End(xlUp).row
    lastCol = ws.cells(7, ws.Columns.count).End(xlToLeft).Column
    arr = ws.Range(ws.Range("A" & 7), ws.cells(lastRow, lastCol)).value
    ActiveSheet.Range("A1").Resize(UBound(arr), UBound(arr, 2)).value = arr
  Next WshtNameCrnt
End Sub