搜索某些文本的第一行，然後複製整個列

Question

我對VBA相當陌生，而且在執行一個看似簡單的任務時遇到了很多麻煩。我已經使用這個網站嘗試了許多不同的代碼，這是讓我最接近我想要的，但它不返回任何值。這裏是什麼，我需要做的前提是：

1）搜索欄的整個第一行（A1讓我們說一個工作表的Z1）特定文本這種「封閉式」

2）如果所需的文本「關閉」的列中的一個被發現，從該列

3）從柱中這些值粘貼到另一個工作表的J列（「Source_Workbook」）

複製所有值*** *編輯**：我想列數據粘貼從J列（10）第5行後面的下一個空行開始粘貼。在這種情況下，我使用「偏移」時遇到了問題。另外，我只需要粘貼值（保持粘貼數據的頁面的格式）。

我的問題是，當我嘗試執行「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：基於評論
這將複製列，並從5排在Sheet2上粘貼。

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