• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Loop within a given range

vijehspaul

Member
Hi,
I have a macro that search for a string and copy-paste the entire row to new place.
Need help for a modifications.
?? Need to set the macro to start pasting the result from a particular cell instead of last row.

Macro i want to modify:

Private Sub Click()

Dim strLastRow As String
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Dim rngtest As String
Application.ScreenUpdating = False

Set wSht = Worksheets("Sheet2")
strToFind = InputBox("Enter the SIC code to find")

With ActiveSheet.Range("A1:A100")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
strLastRow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1
rngC.EntireRow.Copy wSht.Cells(strLastRow, 1)
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With

MsgBox ("Finished")

End Sub


Please help.

Thanks in advance.
 
Just little bit modification in the existing code.

Code:
Sub Click()

Dim strLastRow As String
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Dim rngtest As String
Application.ScreenUpdating = False

Set wSht = Worksheets("Sheet2")
strToFind = InputBox("Enter the SIC code to find")

With ActiveSheet.Range("A1:A100")
    Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
    If Not rngC Is Nothing Then
        FirstAddress = rngC.Address
        strLastRow = InputBox("Enter the Row Number from wheer you want to start pasting:")
        Do
            rngC.EntireRow.Copy
            wSht.Cells(strLastRow, 1).Insert
            Set rngC = .FindNext(rngC)
            strLastRow = strLastRow + 1
        Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
    End If
End With

MsgBox ("Finished")

End Sub
 
Back
Top