Loop to Copy rows based in Text in to new work book, support with destination

[loubdizzy]

Hey guys,

I found this code really helpful initially to go through a sheet and copy out specific row if column A matched the text criteria.

However it copies the data to the exacts same place in the new template I copy too. which now that there are more text criteria groups its getting a little annoying.

Do I need to add in a For ( row count or something). I would like the data to be pasted from A5 in the Template.xlsx.

Suggestions would be welcome, examples I have seen will make me change this up a little too much and there are a lots of these in the script, so trying to reduce too much editing if at all possible.

With Sheets(4)
    
    For Each Cell In .Range("A4:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        If Cell.Value = "BTB" Then
            .Rows(Cell.Row).Copy Destination:=Workbooks("Template.xlsx").Worksheets("BTB 2021").Rows(Cell.Row)
        End If
    Next Cell

End With

Many thanks

 

[loubdizzy]

Hey guys,

I found this code really helpful initially to go through a sheet and copy out specific row if column A matched the text criteria.

However it copies the data to the exacts same place in the new template I copy too. which now that there are more text criteria groups its getting a little annoying.

Do I need to add in a For ( row count or something). I would like the data to be pasted from A5 in the Template.xlsx.

Suggestions would be welcome, examples I have seen will make me change this up a little too much and there are a lots of these in the script, so trying to reduce too much editing if at all possible.

With Sheets(4)
   
    For Each Cell In .Range("A4:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        If Cell.Value = "BTB" Then
            .Rows(Cell.Row).Copy Destination:=Workbooks("Template.xlsx").Worksheets("BTB 2021").Rows(Cell.Row)
        End If
    Next Cell

End With

Many thanks

ok I solved this ...

i changed line

  .Rows(Cell.Row).Copy Destination:=Workbooks("Template.xlsx").Worksheets("BTB 2021").Rows(Cell.Row)

to ....

.Rows(Cell.Row).Copy Destination:=Workbooks("Template.xlsx").Worksheets("Weekly Activty Plan").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

All is ok in the world, keeping up in case others stumble across this issue