Search code examples
excelvbacopy-pasteworksheet

Copy values from multiple sheets to another workbook


I want to copy values from multiple worksheets from Reference Workbook, and paste the values to Report Sheet in Output Workbook.

The VBA is to:

  1. Copy values from the multiple sheets in the Reference Workbook (A12 to lastrow).
  2. Skip Sheet1 ~ Sheet4, and begin copying from Sheet5.
  3. Paste the values to Report sheet in the Output Workbook (B9 to lastrow).
  4. Loop until end of the worksheet in the Reference Workbook.

Values correctly copy from each worksheet in Reference workbook but on the Output workbook, it is only pasting the last worksheet's values.

Sub copy()
Dim reference As String
Dim ws As Worksheet, outSht As Worksheet
Dim wb As Workbook
Dim lastrow1 As Long, lastrow2 As Long

'Dynamic file name
reference = ThisWorkbook.Sheets("Sheet1").Cells(4, 2).Value

'thisworkbook is the Output Workbook
Set outSht = ThisWorkbook.Sheets("Sheet1")

'Reference Workbook
Set wb = Workbooks.Open(reference)

Application.ScreenUpdating = False

'every worksheet in the reference workbook
For Each ws In wb.Worksheets
    
    'identify the lastrow for Reference Workbook & Workbook Output
    lastrow1 = ws.Range("A" & Rows.Count).End(xlUp).Row
    lastrow2 = outSht.Cells(outSht.Rows.Count, "B").End(xlUp).Row + 1
    
    'skip sheet 1~4 in the Reference Workbook
    If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" And ws.Name <> "Sheet3" And ws.Name <> "Sheet4" Then
        
        'copy A12 to lastrow in a sheet
        ws.Range("A12:A" & lastrow1).copy
        
        'paste copied values to paste values to Output Workbook's column B9 to lastrow
        ThisWorkbook.Sheets("Sheet1").Range("B9:B" & lastrow2).PasteSpecial Paste:=xlPasteValues
        
    End If
Next ws

    Application.ScreenUpdating = True

End Sub

Solution

  • You need to copy data from A12 then after lastrow1 you need to check if the number above 12 else you need to go to next sheet means there is no data in this sheet

    If lastrow1 < 12 Then
      GoTo NextIteration
    End If
    

    Then you need to check lastrow2 on B column if below 9 that's mean you didn't copy any data yet and you need to set it to 9

    If lastrow2 < 9 Then
      lastrow2 = 9
    End If
    

    last thing the paste code

    ThisWorkbook.Sheets("Sheet1").Range("B9:B" & lastrow2).PasteSpecial Paste:=xlPasteValues
    

    why you put B9:B that's means always you copy same place you need to change it like this

    ThisWorkbook.Sheets("Sheet1").Range("B" & lastrow2).PasteSpecial Paste:=xlPasteValues
    

    below is the complete code

    Sub copy()
      Dim reference As String
      Dim ws As Worksheet, outSht As Worksheet
      Dim wb As Workbook
      Dim lastrow1 As Long, lastrow2 As Long
    
      'Dynamic file name
       reference = ThisWorkbook.Sheets("Sheet1").Cells(4, 2).Value
    
      'thisworkbook is the Output Workbook
      Set outSht = ThisWorkbook.Sheets("Sheet1")
    
      'Reference Workbook
      Set wb = Workbooks.Open(reference)
    
      Application.ScreenUpdating = False
    
      'every worksheet in the reference workbook
      For Each ws In wb.Worksheets
    
         'identify the lastrow for Reference Workbook & Workbook Output
         lastrow1 = ws.Range("A" & Rows.Count).End(xlUp).Row
         If lastrow1 < 12 Then
            GoTo NextIteration
         End If
         lastrow2 = outSht.Cells(outSht.Rows.Count, "B").End(xlUp).Row + 1
         If lastrow2 < 9 Then
            lastrow2 = 9
         End If
    
        'skip sheet 1~4 in the Reference Workbook
        If ws.Name <> "Sheet1" And ws.Name <> "Sheet2" And ws.Name <> "Sheet3" And    
        ws.Name <> "Sheet4" Then
        
           'copy A12 to lastrow in a sheet
           ws.Range("A12:A" & lastrow1).copy
        
          'paste copied values to paste values to Output Workbook's column B9 to 
           lastrow
          ThisWorkbook.Sheets("Sheet1").Range("B" & lastrow2).PasteSpecial 
          Paste:=xlPasteValues
        
        End If
        NextIteration:
      Next ws
    
      Application.ScreenUpdating = True
    
      End Sub