[英]Search Specific Value and Copy Row to paste in new Sheet from Entire Workbook
[英]How to search for part of a text in row 1 and copy/paste that entire column onto a new sheet
我正在嘗試在電子表格的第1行中搜索部分文本。 如果第1行中的單元格包含該文本,那么我想將整列粘貼到工作簿中的新工作表上。
我每天早上收到一份包含50多個專欄的報告,但我只關心其中的5列。 問題在於列的順序並不總是相同,因此我不能只寫代碼每天復制列C。
請參見下面的示例數據。 例如,我想在第1行中搜索包含“西紅柿”的所有單元格,然后將整列復制到新的工作表中。
我可以找到的唯一代碼如下。 但是,如果找到了文本,它將處理復制特定的行。 另外,我不確定代碼是否在搜索部分匹配或完全匹配。
Private Sub CommandButton1_Click()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start search in row 4
LSearchRow = 4
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column E = "Mail Box", copy entire row to Sheet2
If InStr("A:AZ" & CStr(1)).Value = "Country" Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
Wend
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
在此方面的任何幫助將不勝感激!
嘗試這個:
Sub SearchFirstRowPasteEntireColumn()
With Sheets("Sheet1")
LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
ColumnCounter = 1
For col = 1 To LastColumn
If .Cells(1, col) Like "*SEARCH KEY HERE*" Then
.Columns(col).Copy Destination:=Sheets("Sheet2").Columns(ColumnCounter)
ColumnCounter = ColumnCounter + 1
End If
Next
End With
End Sub
宏在Sheet1的第一行中搜索包含“ SEARCH KEY HERE”的單元格,如果找到任何內容,它將復制到Sheet2的第一空白列。
宏會一直搜索到Sheet1的最后一列,然后粘貼到Sheet2的下一個空白列
通過找到要復制的列的最后一行,這應該可以正常工作並在一定范圍內進行復制。
我已經建立了工作表對象,因為我不確定您的工作表是什么,您可以在例程開始時( Sheet1
/ Sheet2
)更改一次對它們的引用,而不必擔心其余的代碼。 另外,還為您的關鍵字添加了一個變量,您可能希望通過實現函數或循環瀏覽某個范圍內或某個范圍內的關鍵字列表來輕松更改此設置。
Sub eh()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim lCol1 As Long
Dim lCol2 As Long
Dim lRow As Long
Dim i As Long
Dim MY_TEXT_TO_MATCH As String
MY_TEXT_TO_MATCH = "tomato"
Set WS1 = ThisWorkbook.Worksheets("Sheet1")
Set WS2 = ThisWorkbook.Worksheets("Sheet2")
lCol1 = WS1.Cells(1, WS1.Columns.Count).End(xlToLeft).Column
For i = 1 To lCol1
If WS1.Cells(1, i).Value2 Like "*" & MY_TEXT_TO_MATCH & "*" Then
lCol2 = WS2.Cells(1, WS2.Columns.Count).End(xlToLeft).Column + 1
lRow = WS1.Cells(WS1.Rows.Count, i).End(xlUp).Row
WS2.Range(Cells(1, lCol2).Address, Cells(lRow, lCol2).Address).Value = _
WS1.Range(Cells(1, i).Address, Cells(lRow, i).Address).EntireColumn.Value
End If
Next i
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.