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

发布于 2024-11-08 06:14:11 字数 733 浏览 0 评论 0原文

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

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

原文

I am trying to create a Macro that will look through all the worksheets in a workbook and find the column named "ID". There will be an "ID" column in most of the worksheets, but the header may not necessarily be in row 1. Once the column has been found I would like to copy all the data in that column to a new worksheet. When copying the data over to a new worksheet I would like the data to be copied all in column A in the new worksheet- so would like the data to be copied into the next blank cell. So far this is what I have got

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

I cant seem to get the last bit right that pastes the data. At the moment it just pastes it in the next available column.

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

凉宸 2024-11-15 06:14:11

那么，您希望所有内容都在 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

So, you want all in Column A, right?

Change to

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

from

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

回复收藏 0 原文

凉墨 2024-11-15 06:14:11

这会将 ID 标题排列在第 1 行：

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

This will line up the ID headers on row 1:

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

回复收藏 0 原文

~没有更多了~