VBA Code to copy multiple worksheet to another workbook-CodePudding

Hi I need help with a VBA code. I am trying to copy data from multiple worksheets using Loop to another workbook. Please help check the code below. The code breaks when it gets to Set wsCopy = Workbooks("acex_resultsv1.xlsm").Worksheets(i). I will really appreciate your help.

Public Sub Update_Dashboard()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

Dim i As Integer

i = 1

Do While i <= Worksheets.Count
    Worksheets(i).Select

 Set wsCopy = Workbooks("acex_resultsv1.xlsm").Worksheets(i)
 Set wsDest = Workbooks("acex_results.xlsm").Worksheets(i   1)


lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
  

lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row


wsDest.Range("A2:BI" & lDestLastRow).ClearContents


  wsCopy.Range("A2:BI" & lCopyLastRow).Copy _
  wsDest.Range("A2")
  
 ActiveCell.Offset(1, 0).Select
 i = i   1
 Loop
 Worksheets("Dashboard").Select

 End Sub

CodePudding user response：

I'm with Tim. Declare variables for source and destination workbooks, Worksheets.Count should be the count worksheets in wbSource.

Also note there is no reason to .Select anything in this process. It only hogs memory.

CodePudding user response：

Untested:

Public Sub Update_Dashboard()

    Dim wbCopy As Workbook, wsCopy As Worksheet
    Dim wbDest As Workbook, wsDest As Worksheet
    Dim lCopyLastRow As Long, lDestLastRow As Long, i As Long
    
    Set wbCopy = Workbooks("acex_resultsv1.xlsm")
    Set wbDest = Workbooks("acex_results.xlsm") 'ThisWorkbook?
    
    For i = 1 To wbCopy.Worksheets.Count
    
        Set wsCopy = wbCopy.Worksheets(i)
        Set wsDest = wbDest.Worksheets(i   1)
    
        lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).row
        lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).row
        wsDest.Range("A2:BI" & lDestLastRow).ClearContents
        wsCopy.Range("A2:BI" & lCopyLastRow).Copy wsDest.Range("A2")
    
    Next i
     
    wbDest.Worksheets("Dashboard").Select

End Sub