VBA：從多個作業表復制值并粘貼到另一個作業簿

我正在制作一個 VBA，它從參考作業簿中的多個作業表中復制值，并將這些值粘貼到輸出作業簿中的報告表中。

我得到了這樣的部分：

1. VBA 轉到參考作業簿
2. 跳過 sheet1 到 sheet4
3. 開始從 sheet5 的 A 列復制值，依此類推
4. 粘貼到輸出作業簿的報告表

問題是：

1. 值是從參考作業簿中的每個作業表中正確復制的
2. 但在輸出作業簿上，它只粘貼最后一個作業表的值

下面是VBA代碼

預先感謝您！

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

VBA 將：

1. 復制參考作業簿中多張紙的值（A12 到 lastrow）。
2. 跳過 Sheet1 ~ Sheet4，從 Sheet5 開始復制。
3. 將值粘貼到輸出作業簿中的報告表（B9 到 lastrow）。
4. 回圈直到參考作業簿中的作業表結束。

uj5u.com熱心網友回復：

您需要從 A12 復制資料，然后在 lastrow1 之后，您需要檢查是否高于 12 的數字，否則您需要轉到下一張表意味著此表中沒有資料

If lastrow1 < 12 Then
  GoTo NextIteration
End If

然后你需要檢查 B 列上的 lastrow2 如果低于 9 這意味著你還沒有復制任何資料，你需要將它設定為 9

If lastrow2 < 9 Then
  lastrow2 = 9
End If

最后一件事是粘貼代碼

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

為什么你放 B9:B 這意味著你總是復制同一個地方你需要像這樣改變它

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

下面是完整的代碼

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

標籤：擅长vba复制粘贴工作表

上一篇：是否有一個html生成器可以讓我從MicrosoftWord或Excel重新創建外觀

下一篇：使用Python回圈遍歷Pandas資料框或Excel表