search某些文本的第一行，然后复制整个列

我对VBA相当陌生，在做一个看似简单的任务时遇到了很多麻烦。 我已经尝试了许多不同的代码使用这个网站，这是让我最接近我想要的，但它不会返回任何值。 这是我需要做的前提：

1）search工作表的整个第一行（A1，让我们说，Z1）的特定文本，如“closures”

2）如果在其中一列中find所需文本“Closed”，则复制该列中的所有值

3）将这些值从列中粘贴到另一个工作表（“Source_Workbook”）的J列

****编辑**：我想列数据粘贴从第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上的值之前，您正在退出循环。
试试这个代码：

 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