Sheet(LIST2)有8列.Sheet(LIST2)的A列包含ID号.A列的许多行中多次重复相同的ID号.B到H列包含其他数据。 在sheets(Sheet1)A1中,键入一个ID号,该数字在Sheets(LIST2)列A中找到匹配项,并将每个数学行从A复制到H
我找到了复制整个行的代码,但我想要的只是行A到行H
Sub SearchForString()
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 3
Dim sheetTarget As String: sheetTarget = "sheet1"
Dim sheetToSearch As String: sheetToSearch = "LIST2"
Dim targetValue As String: targetValue = Sheets(sheetTarget).Range("A1").Value 'Value in sheet2!A1 to be searched in sheet1
Dim columnToSearch As String: columnToSearch = "A"
Dim iniRowToSearch As Integer: iniRowToSearch = 2
Dim LSearchRow As Long 'As far as it is not clear the number of rows you will be considering, better relying on the long type
Dim maxRowToSearch As Long: maxRowToSearch = 2000 'There are lots of rows, so better setting a max. limit
If (Not IsEmpty(targetValue)) Then
For LSearchRow = iniRowToSearch To Sheets(sheetToSearch).Rows.Count
'If value in the current row (in columnToSearch in sheetToSearch) equals targetValue, copy entire row to LCopyToRow in sheetTarget
If Sheets(sheetToSearch).Range(columnToSearch & CStr(LSearchRow)).Value = targetValue Then
'Select row in Sheet1 to copy
Sheets(sheetToSearch).Rows(LSearchRow).Copy
'Paste row into Sheet2 in next row
Sheets(sheetTarget).Rows(LCopyToRow).PasteSpecial Paste:=xlPasteValues
Sheets(sheetTarget).Rows(LCopyToRow).PasteSpecial Paste:=xlFormats
'Move counter to next row
LCopyToRow = LCopyToRow + 1
End If
If (LSearchRow >= maxRowToSearch) Then
Exit For
End If
Next LSearchRow
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select
End If
Exit Sub
Err_Execute:
结束子
我喜欢将A列中的每一行复制并粘贴到H列中
答案 0 :(得分:0)
您需要更改要复制的范围,因此要复制整行,您只需复制所需的列即可
您可以尝试使用此行吗?
Sheets(sheetToSearch).Range("a" & LSearchRow, "h" & LSearchRow).Copy
'Paste row into Sheet2 in next row
Sheets(sheetTarget).Range("a" & LCopyToRow).PasteSpecial Paste:=xlPasteValues
Sheets(sheetTarget).Range("a" & LCopyToRow).PasteSpecial Paste:=xlFormats
为避免在更改“ ID”时覆盖“ A3”,您是否可以尝试以此替换“ sub”的开头?
Sub matchandcopy()
Dim LCopyToRow As Integer
Dim sheetTarget As String: sheetTarget = "sheet1"
Dim sheetToSearch As String: sheetToSearch = "LIST2"
Dim targetValue As String: targetValue = Sheets(sheetTarget).Range("A1").Value 'Value in sheet2!A1 to be searched in sheet1
Dim columnToSearch As String: columnToSearch = "A"
Dim iniRowToSearch As Integer: iniRowToSearch = 2
Dim LSearchRow As Long 'As far as it is not clear the number of rows you will be considering, better relying on the long type
Dim maxRowToSearch As Long: maxRowToSearch = 2000 'There are lots of rows, so better setting a max. limit
LCopyToRow = Sheets(sheetTarget).Range("a1").End(xlDown).Row + 1
If LCopyToRow > 100000 Then LCopyToRow = 3
If (Not IsEmpty(targetValue)) Then 'here goes the rest of the sub with no changes ....