question about using variable in a range to copy

[ces005]

Hi,

I am trying to copy rows from one sheet to another if the value in a cell contains a substring like "apple". Some comments below contain questions because I am unsure how to do it. There is probably a better more efficient way to do this.

Eileen

    Rw = Range("A65536").End(xlUp).Row
    Counter1 = 9    ' this is where I want to start checking
    Counter2 = 9 ' keeps track of row in new sheet
    Do Until Counter1 > Rw
        ' I am checking the value in column 5 of the current row

        ' check it the string contains "apple" (not sure what to use for substring comparison)
        If Cells(Counter1, 5) contains "apple" Then
           Rows("Counter1:Counter1").Select
           Selection.Copy



           ' not sure how to use a variable inside of a cell reference.
           ' if Counter 2 is 5, then I want the below to select the row
           ' associated with A5

           Range("A{Counter2}").Select

           ' if new sheet does not exist, create it
           ' not sure what check is used to see if a sheet exists
           Sheets("New Sheet").Select
           ActiveSheet.Paste
           Counter2 = Counter2 + 1

           ' not sure if I have to keeping selecting sheets back and forth 
           ' when I am copying and pasting
           Sheets("name of sheet which script is copying from").Select

      end if
        

    Counter = Counter + 1
    Loop

 

[erik.van.geit]

Hi,

this works for me

Option Explicit

Sub test()
Dim Rw As Long
Dim counter1 As Long
Dim counter2 As Long
Dim SourceSh As Worksheet
Dim DestSh As Worksheet

Const NewShName = "New Sheet"

    Rw = Range("A" & Rows.Count).End(xlUp).Row
    counter1 = 9                ' this is where I want to start checking
    counter2 = 9                ' keeps track of row in new sheet
    Set SourceSh = ActiveSheet  'or any sheet
    
Application.ScreenUpdating = False

    On Error Resume Next
    Sheets(NewShName).Select
        If Err Then
        Err.Clear
        Sheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = NewShName
        End If
    On Error GoTo 0
    Set DestSh = Sheets("New Sheet")

    Do Until counter1 > Rw
        If InStr(1, SourceSh.Cells(counter1, 5), "apple") > 0 Then
        SourceSh.Rows(counter1).Copy DestSh.Range("A" & counter2)
        counter2 = counter2 + 1
        End If
    counter1 = counter1 + 1
    Loop

Application.ScreenUpdating = True

End Sub

there is at least one solution which would run faster
check out autofilter (custom, contains)
you could filter out the required rows and copy everything at once
but for learning purposes it's good to compare your code with this one

kind regards,
Erik