CODEWITHSUNDEEP
excelvbacopy-pasteworksheet
MASS_PANIC
MASS_PANIC

Reputation: 21

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

Upvotes: 1

Views: 1028

Answers (1)

cooogeee
cooogeee

Reputation: 189

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

Upvotes: 1

Related Questions