Question

我有一个VBA宏代码如下。此宏基本上从工作表2的A列中的第1个单元格复制字符串，并在同一工作簿的工作表1的A列中找到它。搜索后，它将整行复制并粘贴到表格1中。我编写了如下代码。我需要在第2行到最后一行发生相同的过程，并在第1页的A列填充行数据。

Sub Macro5()
'
' Macro5 Macro
'

    Range("A2").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("D9").Select
    Cells.Find(What:="F7P51PA#UUF", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("Sheet2").Select
    Range("B2:E2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("B121").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Range("A3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("C118").Select
    Cells.Find(What:="F7P99PA#UUF", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("Sheet2").Select
    Range("B3:E3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("B174").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Range("A4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("D167").Select
    Cells.Find(What:="F7Q00PA#UUF", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("Sheet2").Select
    Range("B4:E4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("B175").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select
    Range("A5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("D162").Select
    Cells.Find(What:="F7Q07PA#UUF", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("Sheet2").Select
    Range("B5:E5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Range("B182").Select
    ActiveSheet.Paste
    Range("E176").Select


End Sub

Answer 1

您可以尝试使用此代码更改for循环中的范围...

Public Sub macro5()

    Sheets("Sheet2").Activate
    Range("A2").Activate
    For Each cel In Sheets("Sheet2").Range("A2:A100")
        If cel <> Empty Then
            With Sheets("Sheet1").Range("A:A")
                x = cel.Value
               Set c = .Find(What:=cel.Value, LookIn:=xlValues)
               y = c.Address
               If Not c Is Nothing Then
                Sheets("Sheet2").Range(y).Offset(0, 1).Resize(, 5).Copy Destination:=Sheets("Sheet1").Range(y).Offset(0, 1)
               End If
            End With
        End If

    Next

End Sub

宏从第2行到最后一行重复相同的过程，在那里找到数据

1 个答案: