修改VBA代码实现仅复制匹配行的A-H列至目标工作表

没问题，我帮你调整这段VBA代码，让它只复制匹配行的A到H列，而不是整行。核心改动是把整行复制/粘贴的逻辑替换成指定A:H列范围的操作，具体修改后的代码如下：

Sub SearchForString()
    Dim LCopyToRow As Integer
    On Error GoTo Err_Execute
    
    'Start copying data to row 3 in sheetTarget (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 sheet1!A1 to be searched in LIST2
    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 A:H columns
            If Sheets(sheetToSearch).Range(columnToSearch & CStr(LSearchRow)).Value = targetValue Then
                '修改点1：仅复制当前行的A到H列
                Sheets(sheetToSearch).Range("A" & LSearchRow & ":H" & LSearchRow).Copy
                
                '修改点2：粘贴到目标表对应行的A到H列
                Sheets(sheetTarget).Range("A" & LCopyToRow & ":H" & LCopyToRow).PasteSpecial Paste:=xlPasteValues
                Sheets(sheetTarget).Range("A" & LCopyToRow & ":H" & LCopyToRow).PasteSpecial Paste:=xlFormats
                
                'Move counter to next row
                LCopyToRow = LCopyToRow + 1
            End If
            
            If (LSearchRow >= maxRowToSearch) Then Exit For
        Next LSearchRow
        
        'Position on cell A3
        Application.CutCopyMode = False
        Sheets(sheetTarget).Range("A3").Select
    End If
    
    Exit Sub
Err_Execute:
    MsgBox "An error occurred: " & Err.Description '可选添加错误提示，方便调试
End Sub

关键修改说明： #

• 把原代码中整行复制的Sheets(sheetToSearch).Rows(LSearchRow).Copy，替换为明确指定A:H列范围的Sheets(sheetToSearch).Range("A" & LSearchRow & ":H" & LSearchRow).Copy
• 粘贴时同步调整目标范围为Sheets(sheetTarget).Range("A" & LCopyToRow & ":H" & LCopyToRow)，确保只覆盖目标表的A到H列，不会影响其他列数据
• 给错误处理分支加了错误提示语句，方便你调试时快速定位问题（如果不需要可以直接删除）

内容的提问来源于stack exchange，提问作者George