试图从工作簿中的多个工作表复制特定范围到另一个工作簿中的一个工作表vba Excel？

Question

    Sub CollectData()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Application.DisplayAlerts = False
    Set wb1 = ThisWorkbook
    Set wb2 = Workbooks.Open("Path")
    Set ws1 = wb1.Sheets("Jan")
    For Each ws2 In wb2.Sheets
    If Len(ws2.Name) > 0 Then
    ws2.Range("A2:G50").Copy Destination:=ws1.Range("A2:G50")
    End If
    Next ws2
    Application.DisplayAlerts = True
    wb2.Close (savechanges = True)

谢谢，问候

Answer 1

我也是一个初学者，我在我的平板电脑上打字，所以我不能测试您的代码，但看起来您总是粘贴到相同的范围，从而覆盖了循环中以前的粘贴。您的目标范围需要是动态的，才能粘贴到下一个空范围中，以避免覆盖。

更新：

我不得不回到这个问题上来，因为我假设您每次运行循环时都在复制以前的粘贴。我的代码可能有点粗糙，但正如我所说的，我自己仍然在学习基础知识。更新工作簿中的“路径”。打开行并尝试一下。应该对你有用。

Sub CollectData()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Dim NextRow As Long
    
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Sheets("Jan")
  
    Application.DisplayAlerts = False
    
    Set wb2 = Workbooks.Open("Path")
   
    For Each ws2 In wb2.Sheets
    If Len(ws2.Name) > 0 Then
    NextRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
    ws2.Range("A2:G50").Copy ws1.Range("A" & NextRow)
    End If
    Next ws2
    Application.DisplayAlerts = True
    wb2.Close True
End Sub