在第一行搜索特定文本，然后复制整列

Question

我是 VBA 的新手，在完成一项看似简单的任务时遇到了很多麻烦。我已经使用该网站尝试了许多不同的代码，这是最接近我想要的代码的代码，但它没有 return 任何值。这是我需要它做的前提：

1) 在工作表的整个第一行列（假设为 Z1）搜索特定文本，例如 "Closed"

2) 如果在其中一列中找到所需的文本 "Closed"，则复制该列中的所有值

3) 将列中的这些值粘贴到另一个工作表的列 J ("Source_Workbook")

****编辑**：我希望从 J (10) 列第 5 行之后的下一个空行开始粘贴列数据。在这种情况下，我在使用 "Offset" 时遇到了问题。另外，我只想粘贴值（保留粘贴数据的页面的格式）。

我的问题是，当我尝试这样做时，这段代码总是给我错误 "Range.PasteSpecial." 我希望我有正确的方法。如果我能进一步澄清，请告诉我。

    Dim rng As Range
    Dim cl As Object
    Dim strMatch As String

    strMatch = "Closed" 'Search first row for columns with "Closed"
    Set rng = Target_Workbook2.Sheets(2).Range("A1:Z1")
    For Each cl In rng
        If cl.Value = strMatch Then
            cl.EntireColumn.Copy
            Exit For
            With Source_Workbook2.Sheets(2)
                Sheets(2).Columns("J").Offset(5, 0).PasteSpecial xlPasteValues
            End With
        End If
    Next cl

会

    Target_Workbook2.Sheets(2).Range("A1:Z1").AutoFilter 1, "*Closed*"

可能过滤效果更好？

Answer 1

在将值粘贴到 Sheet2 之前，您正在退出 for 循环。
试试这个代码：

Dim rng As Range
Dim cl As Object
Dim strMatch As String

strMatch = "Closed" 'Search first row for columns with "Closed"
Set rng = Target_Workbook2.Sheets(2).Range("A1:Z1")
For Each cl In rng
    If cl.Value = strMatch Then
        cl.EntireColumn.Copy Destination:=Sheets("Sheet2").Columns(10)
        Exit For
    End If
Next cl

编辑 1：根据评论
这将复制该列并将其从 Sheet2 的第 5 行粘贴。

Dim rng As range
Dim cl As Object
Dim strMatch As String
Dim lastrow As Long
Dim sh2lastrow As Long      '<--    Newly added
Dim col As Long                 '<--    Newly added
Dim range As range              '<--    Newly added

strMatch = "Closed" 'Search first row for columns with "Closed"
lastrow = Sheets("Sheet1").range("A65536").End(xlUp).Row ' or + 1
sh2lastrow = Sheets("Sheet2").range("J65536").End(xlUp).Row + 4     '<--    Newly added (Because you want to start from row 5)
Set rng = Sheets("Sheet1").range("A1:Z1")
For Each cl In rng
    If cl.Value = strMatch Then
        lastrow = Cells.CurrentRegion.Rows.Count        '<--    (Getting row count of given column)
        col = cl.Column                                     '<--    (Getting column number of given column)
        With Sheets("Sheet1")
            Set range = .range(.Cells(2, col), .Cells(lastrow, col))        '<--    (Setting up the range to copy)
        End With
        range.Copy
        Sheets("Sheet2").Activate       '<--    Newly added
        Sheets("Sheet2").range("J" & sh2lastrow).PasteSpecial xlPasteValues     '<--    (Pasting the copied data)
        sh2lastrow = Sheets("Sheet2").range("J65536").End(xlUp).Row + 1     '<--    (Getting the last row from Sheet2)
        Sheets("Sheet1").Activate
    End If
Next cl

在第一行搜索特定文本，然后复制整列

Search first row for certain text, then copy entire column

excel

search

vba

rows

filter