☰

Excel VBA - 将多张工作表中的数据复制到一个表中

tag-icon • tag-icon microsoft-excel worksheet-function vba
Excel VBA - 将多张工作表中的数据复制到一个表中

我希望能够将多张工作表中的数据复制到一个表中，而不删除该表的格式。

  • 从每张表复制的数据始终包含 6 列
  • 但每张表的行数会有所不同。
  • 此外，我不希望复制每张表的前两行。
  • 我希望将所有复制的工作表中的数据逐个粘贴到从 B2 开始的单个预先存在的表中，而不删除表格的格式。

有什么建议么？

答案1

使用如下的宏可以轻松实现：

Option Explicit
Sub copyrange()
Application.ScreenUpdating = False
    Dim DestRng As Range, r As Long
    For r = 2 To 7
        Set DestRng = Sheet1.Range("A" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1)
        Sheets(r).Range("A3:F" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row).Copy
        DestRng.PasteSpecial xlPasteValues
    Next r
Application.ScreenUpdating = True
End Sub

或者：

Sub copyrange2()
Application.ScreenUpdating = False
    Dim DestRng As Range, r As Long
    Dim DestSht As Worksheet: Set DestSht = Sheet1
    Dim sht1 As Worksheet: Set sht1 = Sheets("2ndSheet")
    Dim sht2 As Worksheet: Set sht2 = Sheets("Sheet3")
    Dim sht3 As Worksheet: Set sht3 = Sheets("Sheet4")
    Dim sht4 As Worksheet: Set sht4 = Sheets("Sheet5")
    Dim sht5 As Worksheet: Set sht5 = Sheets("Sheet6")
    Dim sht6 As Worksheet: Set sht6 = Sheets("Sheet7")
    Dim shts
    shts = Array(Sheets("2ndSheet"), Sheet3, Sheet4, Sheet5, Sheet6, Sheet7)
    For r = 0 To 5
        Set DestRng = DestSht.Range("A" & DestSht.Cells(Rows.Count, 1).End(xlUp).Row + 1)
        shts(r).Range("A3:F" & shts(r).Cells(Rows.Count, 1).End(xlUp).Row).Copy
        DestRng.PasteSpecial xlPasteValues
    Next r
Application.ScreenUpdating = True
End Sub

您还可以将正在访问的表保存在单独的工作簿中，并使用数据查询对其进行查询。

HTH 贾斯汀

相关内容