I am making a VBA that copy values from multiple worksheets from Reference Workbook, and paste the values to Report Sheet in Output Workbook.

I got to the part that:

1. VBA goes to Reference workbook
2. skip sheet1 to sheet4
3. begin copy values on the A columns from sheet5 and so on
4. paste to the Output workbook's Report Sheet

The issue is that:

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

below is the VBA code

Thank you in an advance!

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

The VBA is to:

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

CodePudding user response：

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