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

我正在尝试创build一个macros来查看工作簿中的所有工作表，并find名为“ID”的列。 在大多数工作表中会有一个“ID”列，但是头部可能不一定在第1行。一旦find列，我想将该列中的所有数据复制到新的工作表中。 将数据复制到新工作表时，我希望将数据全部复制到新工作表的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 

我似乎无法得到粘贴数据的最后一个位。 目前它只是将其粘贴到下一个可用列中。

Answer 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 

Answer 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