Paste onto next available row

[RookieHelp!]

Hello, I have a macro which copies a row of cells from one worksheet to another depending on a value of a cell in column G. If that value is '100', then it copies it to a tab called '100', if the value is 'Other' then it copies it to the 'Other' tab. They get copied to the next available row. (However, they also leave the blank spaces there; if there is some coding to get rid of that, that would also be great, however it is not priority as of yet).

I also have a number of other tabs named after people. These individuals will fill out their own tab and then when they run the macro, it will automatically put the rows into the correct tab. The code I have works for 'Ian', however when I make one for 'James', depending on which is first, the row gets replaced instead of put on the next available row. Please see the code below and I would be extremely grateful if anyone can add some coding, possible just a simple 'Or' function after the 'If a.Range' for the 'James' sheet, which I have set as d.

Thanks in advance!

Sub Transfer()

Set a = Sheets("Ian")
Set b = Sheets("100")
Set c = Sheets("Other")
Set d = Sheets("James")

Dim x
Dim z

x = 1
z = 2

Do Until IsEmpty(a.Range("G" & z))

If a.Range("G" & z) = "100" Then
x = x + 1
b.Rows(x).Value = a.Rows(z).Value

Else

If a.Range("G" & z) = "Other" Then
x = x + 1
c.Rows(x).Value = a.Rows(z).Value

End If
End If
z = z + 1
Loop

End Sub

[Olly]

Please use CODE tags when posting code.

Try something like this:

Sub foo()
    Dim wsSrc As Worksheet, wsTgt As Worksheet
    Dim l As Long
    
    Set wsSrc = Worksheets("Ian")
    
    With wsSrc
        For l = 2 To .Cells(Rows.Count, "G").End(xlUp).Row
            Set wsTgt = Worksheets(CStr(.Cells(l, "G").Value))
            .Rows(l).Copy wsTgt.Cells(wsTgt.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row, 1)
        Next l
    End With
End Sub

[RookieHelp!]

Apologies for not using a code tag. Thank you very much for your reply, however how would i add another worksheet for James and others.

i.e. Set a = Worsheets ("James")

Where would I insert 'a' within the With statement so that it would take into account the value in column G without replacing what is already in there?

Thank you

[Olly]

You may want to adjust it slightly, to deal with any entries in column G which do not have a matching named worksheet:

Sub foo()
    Dim wsSrc As Worksheet, wsTgt As Worksheet
    Dim l As Long
    
    Set wsSrc = Worksheets("Ian")
    
    With wsSrc
        For l = 2 To .Cells(Rows.Count, "G").End(xlUp).Row
            On Error Resume Next
            Set wsTgt = Worksheets(CStr(.Cells(l, "G").Value))
            On Error GoTo 0
            If Not wsTgt Is Nothing Then .Rows(l).Copy wsTgt.Cells(wsTgt.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row, 1)
            Set wsTgt = Nothing
        Next l
    End With
End Sub

[Olly]

This line controls which worksheet is the 'source':

Set wsSrc = Worksheets("Ian")

There are several options for how to apply the code to other / multiple worksheets - you could change this line to only work on the active sheet, so you manually select a sheet, then call the macro;

Set wsSrc = ActiveSheet

Or you could loop through some / all worksheets...

How do you want it to work?

[RookieHelp!]

Could you please do it so that it loops through all the worksheets. I also found that if I were to change the value from 100 to other in the Ian tab after running the macro again, the row would remain in both the 100 and other tab. Is there a way to delete the row from one of the tabs if the value was changed?

[Olly]

Okay, now we have the CODE tags all figured out, let's continue...

Try this. It will loop through all worksheets, and move data to the matching worksheet specified in column G.

Sub foo()
    Dim wsSrc As Worksheet, wsTgt As Worksheet
    Dim l As Long
    
    For Each wsSrc In ThisWorkbook.Worksheets
        With wsSrc
            For l = .Cells(Rows.Count, "G").End(xlUp).Row To 2 Step -1
                On Error Resume Next
                Set wsTgt = Worksheets(CStr(.Cells(l, "G").Value))
                On Error GoTo 0
                If Not wsTgt Is Nothing And Not wsTgt.Name = wsSrc.Name Then
                    With .Rows(l)
                        .Copy wsTgt.Cells(wsTgt.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row, 1)
                        .EntireRow.Delete
                    End With
                End If
                Set wsTgt = Nothing
            Next l
        End With
    Next wsSrc
End Sub

[RookieHelp!]

Sorry, there does not appear to be any code to try...

[Olly]

Oops. There is now.

[RookieHelp!]

That's brilliant, thank you so much! I have had a brainstorm and hoping this does not change everything, if it does, do not worry...

It is possible to have it so that the code does exactly the same thing, but instead of having tabs for each person along the bottom, is it possible to have it so that each person had their own workbook, so that they don't mess about with the current one??

If it is a completely different code then don't worry, I already owe you massively!

[RookieHelp!]

Sorry, if we go back a bit...

When it comes to deleting the row, is there a way just to delete it from the 'Other' and '100' tab if the value in G changes, but keep it in the tab with their names? That way if they say it is 100, then I run the macro, but then they decide it's actually other, I can then re-run the macro and it won't have deleted it from their own tab.

Sorry to be a pain

[Olly]

Try:

Sub foo()
    Dim wsSrc As Worksheet, wsTgt As Worksheet
    Dim l As Long
    
    For Each wsSrc In ThisWorkbook.Worksheets
        With wsSrc
            For l = .Cells(Rows.Count, "G").End(xlUp).Row To 2 Step -1
                On Error Resume Next
                Set wsTgt = Worksheets(CStr(.Cells(l, "G").Value))
                On Error GoTo 0
                If Not wsTgt Is Nothing And Not wsTgt.Name = wsSrc.Name Then
                    With .Rows(l)
                        .Copy wsTgt.Cells(wsTgt.Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).Row, 1)
                        If InStr("Other,100", .Parent.Name) > 0 Then .EntireRow.Delete
                    End With
                End If
                Set wsTgt = Nothing
            Next l
        End With
    Next wsSrc
End Sub

The list highlighted red controls which worksheets the entries will be deleted from.

[RookieHelp!]

When I run it, it does not delete it from the name tabs, which is good, but it does not delete it from the 100 or other tab if it changes. It just adds it to them both

[Olly]

In which case I do not understand your requirement.

When I run it, it does not delete it from the name tabs, which is good, but it does not delete it from the 100 or other tab if it changes. It just adds it to them both

IT, IT, IT. You know what it you are talking about. I don't. Stop saying it! Start describing your requirement more precisely. Try explaining it again. It would be MORE useful to attach a workbook, showing what you start with, and what your required outcome looks like.

[RookieHelp!]

Lets say I am Ian. I fill out column G as 100. I then run the macro and the entire row is added to the '100' tab. I then change my mind and fill out column G as Other. I would like the row to then be deleted out of the '100' tab and added to the 'Other' tab instead.

As the macro is now, the row would get added to the 'Other' tab but would also remain in the '100' tab.

Sorry for the confusion.

[Olly]

The other consideration which should be in your mind - it's all very well having code written for you to achieve a specific requirement. But how do you intend to support it, if you don't understand it?

[RookieHelp!]

Yes, that is why I didn't want to make it too complex. I can understand the code when I see it, but just can't write it.

The code that you have given me is more than enough, I will just delete the data in the 100 and Other tab each time I run the macro (once a month)... will only take 2 seconds.

Thank you so much for all your help, sorry for driving you round the bend!

[Olly]

That's a very different (and very difficult) requirement. How would you identify the rows in worksheet "100" which need to be deleted?
Impossible to write code for that without seeing your workbook, and understanding your workflow better. It's beginning to sound like a rather different project than your initial question, of how to paste onto a next row...

[RookieHelp!]

Apologies, new to this and didn't know what a code tag was, thought you were just a user that couldn't copy the code to test it. Got it now.