宏從第2行重複相同的過程直到找到數據的最後一行

Question

我有一個VBA宏代碼，如下所示。此宏基本上從工作表2的A列中的第1個單元格複製一個字符串，並在同一工作簿的工作表1的A列中找到它。搜索後，它將整行復制並粘貼到工作表1中。我已經編寫了如下代碼。我需要同樣的過程，從第2行的情況發生，直到最後一排，並在表的列A填充行數據1.

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