Vba 如何使用不同的列标题将多张图纸复制到主图纸

我试图创建vba，通过匹配列标题将多个工作表合并到一个主工作表中。我已经从微软找到了多个线程和文档，但我仍然不够。我从其他用户那里获得了很多，并添加了我需要的扭曲。这是我所拥有的

Option Compare Text

Sub cc()

    Dim Sheet As Worksheet
    Dim DestSheet As Worksheet
    Dim Last As Long
    Dim SheetLast As Long
    Dim CopyRange As Range
    Dim StartRow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set DestSheet = Sheet("Database_Headers")
    StartRow = 2

    For Each Sheet In ActiveWorkbook.Worksheets
        If LCase(Left(Sheet.Name, 6)) = "Demand" Then

            Last = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row
            SheetLast = Sheet.Cells(Rows.Count, "A").End(xlUp).Row

            If SheetLast > 0 And SheetLast >= StartRow Then

                Sheet.Select
                Region_Name = WorksheetFunction.Match("Region Name", Rows("1:1"), 0)
                location_code = WorksheetFunction.Match("location_code", Rows("1:1"), 0)
                location_name = WorksheetFunction.Match("location_name", Rows("1:1"), 0)
                dealer_code = WorksheetFunction.Match("dealer_code", Rows("1:1"), 0)

                Sheet.Columns(Region_Name).Copy Destination:=DestSheet.Range("C" & Last + 1)
                Sheet.Columns(location_code).Copy Destination:=DestSheet.Range("D" & Last + 1)
                Sheet.Columns(location_name).Copy Destination:=DestSheet.Range("E" & Last + 1)
                Sheet.Columns(dealer_code).Copy Destination:=DestSheet.Range("F" & Last + 1)

            End If

        End If

        CopyRange.Copy

        With DestSheet.Cells(Last + 1, "C")

        End With

        DestSheet.Cells(Last + 1, "B").Resize(CopyRng.Rows.Count).Value = Sheet.Name

    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

我当前的错误来自：

Set DestSheet = Sheet("Database_Headers") 

但我不确定是否需要进一步澄清，或者是否需要添加进一步澄清行

提前感谢大家的帮助

编辑更新

我已将代码更新为： 选项比较文本

小组委员会（）

Next

ExitTheSub:

Application.Goto DestSheet.Cells(1)

' AutoFit the column width in the summary sheet.
DestSheet.Columns.AutoFit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

端接头

---

我看到关于复制范围函数的另一个错误。我希望vba通过工作表，只复制列标题下的数据，这些数据与主文件中的数据相匹配。谢谢你的帮助

是的，我加载了你的代码，得到了相同的错误。因为你有

Set DestSheet = Sheet("Database_Headers")

但是你应该

Set DestSheet = Sheets("Database_Headers")

之后，您将不得不处理其他错误，例如

For Each Sheet...

您还没有将“Sheet”定义为变量 （使用“Sheet”以外的词，因为这是一个保留词——可能是“sh” 这里有一些代码可以让您开始——我没有足够的信息来真正完成它，但您可能会发现它很有用

Option Explicit
Sub cc()
Dim sh As Worksheet, destSh As Worksheet
Dim s As String, r As Range, i As Integer, j As Integer

Set destSh = Sheets("Database_Headers")
Set destRange = destSh.Range("A1")
For Each sh In Worksheets
  If LCase(Left(Sheet.Name, 6)) = "Demand" Then
    Set r = sh.Range("A1")
    Set r = Range(r, r.End(xlDown))
    For i = 0 To r.Row.Count
      s = r.Offset(i, 0).Value
      If InStr(s, "desired text") Then
        'transferedData = ...
      End If
    Next i
  End If
  'transfer data to destSh
  destRange.Offset(j, 0) = transferedData
  j = j + 1
Next sh

End Sub

---

您的错误在于没有正确参考

工作表
集合。应该这样做：

Set DestSheet=Sheets（“数据库头”）

但是，在这种情况下，您不应参考
工作表
集合，而应参考
工作表
集合，因为您已将
DestSheet
声明为
工作表
，因此可以避免以后出现一些问题。如下所示：

Set DestSheet=工作表（“数据库头”）

通常，这是
工作表
和
工作表
（以及相应的集合）之间的区别-创建一个空Excel并将图表工作表添加为单独的工作表。然后运行以下代码：

Public Sub TestMe()
    Debug.Print Worksheets.Count
    Debug.Print Sheets.Count
End Sub

它将给出
3
和
4
——您有3张Excel工作表和4张工作表（图表工作表是一张工作表）

这里有一个问题，如果您正确使用它，可以避免-
Hi@Vityata，我将
工作表调整为
，将
工作表调整为
sh
，这解决了我原来的问题。我现在遇到了一个问题，我的语句无法从多个单元格复制数据。我需要匹配和追加列标题数据仅显示在摘要选项卡上。我已使用新代码更新了原始问题中的代码。我在
Set CopyRange=Sh处遇到错误。选择
。感谢您的帮助！！
Public Sub TestMe()
    Debug.Print Worksheets.Count
    Debug.Print Sheets.Count
End Sub