Create Loop for Copy data for Multiple occurrence of Sheets("Result").Range("D1").Text
Need a quick help please
VBA Code:
Private Sub CommandButton1_Click()
Dim celldesav As Range
Dim rdesav As Range
Dim searchdesav As String
Set rdesav = Sheets("List").Columns("A:A")
searchdesav = Sheets("Result").Range("D1").Text
Set celldesav = rdesav.Find(What:=searchdesav, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
Sheets("List").Range(celldesav, celldesav.Offset(-4, 0)).Copy
Sheets("Result").Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets("List").Range(celldesav, celldesav.Offset(1, 0)).Copy
Sheets("Result").Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End Sub
Need a quick help please