在工作簿的所有工作表中查找特定的列标题答案

【问题标题】：Looking for specific column headers in all worksheets of a workbook在工作簿的所有工作表中查找特定的列标题
【发布时间】：2013-08-18 23:52:08
【问题描述】：

我正在尝试创建一个宏来查看工作簿中的所有工作表并找到名为“ID”的列。大多数工作表中都会有一个“ID”列，但标题不一定在第 1 行。一旦找到该列，我想将该列中的所有数据复制到新工作表中。将数据复制到新工作表时，我希望将数据全部复制到新工作表的 A 列中，因此希望将数据复制到下一个空白单元格中。到目前为止，这就是我所得到的

Sub Test()

Dim ws As Worksheet
Dim sString As String
Dim sCell As Variant
Dim cfind As Range
Dim j As Integer

  For Each ws In Worksheets
    If ws.Name = "Archive" Then GoTo nextws
    ws.Activate
    j = ActiveSheet.Index
    'MsgBox j
    On Error Resume Next
    Set cfind = Cells.Find(what:="ID", lookat:=xlWhole)
    If Not cfind Is Nothing Then
      cfind.EntireColumn.Copy
      Worksheets("Archive").Range("A1").Offset(0, j - 1).PasteSpecial
    End If
  nextws:
  Next ws

End Sub

我似乎无法正确粘贴数据。目前它只是将其粘贴到下一个可用列中。

【问题讨论】：

尝试先选择A1，Range("A1").Select
如果您在 Stack Overflow 上提出其他问题，请提供比“VBA Excel 帮助！”更具描述性的标题。

标签： excel vba

【解决方案1】：

那么，您希望全部都在 A 列中，对吧？

改成

With Worksheets("Archive")
  If .Range("A1") = "" Then
    .Range("A1").PasteSpecial
  Else
    .Range("A1").Offset(.UsedRange.Rows.Count).PasteSpecial
  End If
End With

来自

Worksheets("Archive").Range("A1").Offset(0, j - 1).PasteSpecial

【讨论】：

【解决方案2】：

这将排列第 1 行的 ID 标题：

Sub Test()

    Const SHT_ARCHIVE As String = "Archive"

    Dim ws As Worksheet
    Dim cfind As Range, rngList As Range
    Dim j As Integer

    j = 0
    For Each ws In Worksheets
        If ws.Name <> SHT_ARCHIVE Then
            j = j + 1
            Set cfind = ws.UsedRange.Find(what:="ID", lookat:=xlWhole, LookIn:=xlValues)
            If Not cfind Is Nothing Then
                Set rngList = Range(cfind, ws.Cells(Rows.Count, cfind.Column).End(xlUp))
                Worksheets(SHT_ARCHIVE).Cells(1, j).Resize(rngList.Rows.Count, 1).Value = rngList.Value
            End If
        End If
    Next ws
End Sub

【讨论】：