Question

我正在尝试创建一个宏来查看工作簿中的所有工作表，并找到名为“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

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

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

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

2 个答案: