Copy from one sheet to another based on data in cell AV

J

jimmisavage

Board Regular
Joined
Jun 28, 2017
Messages
130
Good morning all,
I seem to have stumped myself on a bit of VBA coding and was hoping someone might fancy a challenge!

I have a tab call 'MasterSheet' which is fed by a userform. I need to be able to transfer snippets of rows into different sheets; which my formulas run off.

In MasterSheet, cell AV there will be an input of either "Breakfast" "lunch" "Dinner" or "Snack". The same options are also in Cell AW with the inclusion of " " (because some food might be used for breakfast or snack for instance).

So I will need a macro that will copy some of that row to another sheet and some other cells in that row to another sheet again. Lets start with Snacks.

When "Snack" is entered in either row AV or AW i need the macro to copy columns A:U of that row into a sheet called "SnacksSheet". I then need to copy rows A & V:AA from "MasterSheet" to a sheet called "Snacks" (in both instances I would like to populate column A onwards so there are no black cells (such as B-U).

I need a macro that will do this to all food groups (Breakfast, Lunch, Dinner and Snacks - sheet naming conventions are the same), but not to duplicate (so maybe we need an indicator in call AX to show its already moved that line?). Ideally this would run straight after the macro I used to populate from the userform.

Oh heck, I hope this makes some sense!

Thanks in advance
Stuart
 
Sort by date Sort by votes
As for my issue i'm making steady progress. Using the code above I have made a couple of small changes; one just aims it at column AB, in the hope i could copy the code and rerun it at the bottom to look at column AC but I'm unsure how to marry the 2 codes together?
I have something like this but clearly i'm missing something...

Code: 
Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("AB:AB")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Select Case Target.Value
        Case "Breakfast"
            If Range("AD" & Target.Row) <> "x" Then
                Range("AD" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Lunch"
            If Range("AD" & Target.Row) <> "x" Then
                Range("AD" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Dinner"
            If Range("AD" & Target.Row) <> "x" Then
                Range("AD" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Snacks"
            If Range("AD" & Target.Row) <> "x" Then
                Range("AD" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("SnackssSheet").Cells(Sheets("SnackssSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
            End Select
    Application.ScreenUpdating = True


End Sub (????????????? I don't think it should be end sub here but I don't know what it should be ?????????????)



    If Intersect(Target, Range("AC:AC")) Is Nothing Then Exit Sub
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Application.ScreenUpdating = False
    Select Case Target.Value
        Case "Breakfast"
            If Range("AE" & Target.Row) <> "x" Then
                Range("AE" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Lunch"
            If Range("AE" & Target.Row) <> "x" Then
                Range("AE" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Dinner"
            If Range("AE" & Target.Row) <> "x" Then
                Range("AE" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Snacks"
            If Range("AE" & Target.Row) <> "x" Then
                Range("AE" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("SnackssSheet").Cells(Sheets("SnackssSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
            End Select
    Application.ScreenUpdating = True
End Sub

Many thanks
Stuart
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
You were on the right track. Try:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("AV:AV,AW:AW")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Target.Column = 48 Then
        Select Case Target.Value
            Case "Breakfast"
                If Range("AX" & Target.Row) <> "x" Then
                    Range("AX" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Lunch"
                If Range("AX" & Target.Row) <> "x" Then
                    Range("AX" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Dinner"
                If Range("AX" & Target.Row) <> "x" Then
                    Range("AX" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Snacks"
                If Range("AX" & Target.Row) <> "x" Then
                    Range("AX" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("SnacksSheet").Cells(Sheets("SnacksSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Snacks").Cells(Sheets("Snacks").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Snacks").Cells(Sheets("Snacks").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
        End Select
    ElseIf Target.Column = 49 Then
        Select Case Target.Value
            Case "Breakfast"
                If Range("AY" & Target.Row) <> "x" Then
                    Range("AY" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Lunch"
                If Range("AY" & Target.Row) <> "x" Then
                    Range("AY" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Dinner"
                If Range("AY" & Target.Row) <> "x" Then
                    Range("AY" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Snacks"
                If Range("AY" & Target.Row) <> "x" Then
                    Range("AY" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("SnacksSheet").Cells(Sheets("SnacksSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Snacks").Cells(Sheets("Snacks").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Snacks").Cells(Sheets("Snacks").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
        End Select
    End If
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
I think you can simplify this greatly.

Does this do what you want?
Code: 
Sub Worksheet_Change(ByVal Target As Range)

    Dim LastRow As Long
    Application.ScreenUpdating = False
    
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("AB:AC")) Is Nothing Then Exit Sub
    
    Select Case Target.Value
        Case "Breakfast", "Lunch", "Dinner", "Snacks"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
    End Select
    
    Application.ScreenUpdating = True
    
End Sub
 
Last edited:
Upvote 0
mumps said:
You were on the right track. Try:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("AV:AV,AW:AW")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Target.Column = 48 Then
        Select Case Target.Value
            Case "Breakfast"
                If Range("AX" & Target.Row) <> "x" Then
                    Range("AX" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Lunch"
                If Range("AX" & Target.Row) <> "x" Then
                    Range("AX" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Dinner"
                If Range("AX" & Target.Row) <> "x" Then
                    Range("AX" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Snacks"
                If Range("AX" & Target.Row) <> "x" Then
                    Range("AX" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("SnacksSheet").Cells(Sheets("SnacksSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Snacks").Cells(Sheets("Snacks").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Snacks").Cells(Sheets("Snacks").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
        End Select
    ElseIf Target.Column = 49 Then
        Select Case Target.Value
            Case "Breakfast"
                If Range("AY" & Target.Row) <> "x" Then
                    Range("AY" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Lunch"
                If Range("AY" & Target.Row) <> "x" Then
                    Range("AY" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Dinner"
                If Range("AY" & Target.Row) <> "x" Then
                    Range("AY" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
            Case "Snacks"
                If Range("AY" & Target.Row) <> "x" Then
                    Range("AY" & Target.Row) = "x"
                    Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("SnacksSheet").Cells(Sheets("SnacksSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("A" & Target.Row).Copy Sheets("Snacks").Cells(Sheets("Snacks").Rows.Count, "A").End(xlUp).Offset(1, 0)
                    Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Snacks").Cells(Sheets("Snacks").Rows.Count, "B").End(xlUp).Offset(1, 0)
                Else
                    MsgBox ("This row has already been copied.")
                End If
        End Select
    End If
    Application.ScreenUpdating = True
End Sub
Click to expand...

Hi mumps,
Thanks for trying but it's still not working. This is the code I used:
Code: 
Sub Worksheet_Change(ByVal Target As Range)    If Intersect(Target, Range("AB:AB,AC:AC")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Target.Column = 28 Then
        Select Case Target.Value
        Case "Breakfast"
            If Range("AD" & Target.Row) <> "x" Then
                Range("AD" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Lunch"
            If Range("AD" & Target.Row) <> "x" Then
                Range("AD" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Dinner"
            If Range("AD" & Target.Row) <> "x" Then
                Range("AD" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Snacks"
            If Range("AD" & Target.Row) <> "x" Then
                Range("AD" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("SnackssSheet").Cells(Sheets("SnackssSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        End Select
    If Target.Column = 29 Then
        Select Case Target.Value
        Case "Breakfast"
            If Range("AE" & Target.Row) <> "x" Then
                Range("AE" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Lunch"
            If Range("AE" & Target.Row) <> "x" Then
                Range("AE" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Dinner"
            If Range("AE" & Target.Row) <> "x" Then
                Range("AE" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Snacks"
            If Range("AE" & Target.Row) <> "x" Then
                Range("AE" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("SnackssSheet").Cells(Sheets("SnackssSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        End Select
    End If
    Application.ScreenUpdating = True
    End If
End Sub
 
Upvote 0
Joe4 said:
I think you can simplify this greatly.

Does this do what you want?
Code: 
Sub Worksheet_Change(ByVal Target As Range)

    Dim LastRow As Long
    Application.ScreenUpdating = False
    
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("AB:AC")) Is Nothing Then Exit Sub
    
    Select Case Target.Value
        Case "Breakfast", "Lunch", "Dinner", "Snacks"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
    End Select
    
    Application.ScreenUpdating = True
    
End Sub
Click to expand...

Hi Joe,
This almost seems to work but not quite. If i but breakfast in AB it copies to breakfast but I've also put Lunch in AC but it's not copied it to the lunch tab. Any idea what's missing?
 
Upvote 0
Sorry, I missed that part. Try this:
Code: 
Sub Worksheet_Change(ByVal Target As Range)

    Dim LastRow As Long
    Application.ScreenUpdating = False
    
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("AB:AC")) Is Nothing Then Exit Sub
    
    Select Case Target.Value
        Case "Breakfast", "Lunch", "Dinner", "Snacks"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets(Target.Value & "Sheet").Cells(Sheets(Target.Value & "Sheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
    End Select
    
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
Joe4 said:
Sorry, I missed that part. Try this:
Code: 
Sub Worksheet_Change(ByVal Target As Range)

    Dim LastRow As Long
    Application.ScreenUpdating = False
    
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("AB:AC")) Is Nothing Then Exit Sub
    
    Select Case Target.Value
        Case "Breakfast", "Lunch", "Dinner", "Snacks"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets(Target.Value & "Sheet").Cells(Sheets(Target.Value & "Sheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
    End Select
    
    Application.ScreenUpdating = True
    
End Sub
Click to expand...

That is spot on, thank you!!
I'm also using it on another sheet with a slight modification and i'm wondering if this would work to copy from columns A & AP:AS (without any gaps in columns when pasting - so pasting in to A- E)?
Code: 
[COLOR=#333333]Range("A" & "AP" & Target.Row & ":AS" & Target.Row)[/COLOR]
 
Upvote 0
I'm also using it on another sheet with a slight modification and i'm wondering if this would work to copy from columns A & AP:AS (without any gaps in columns when pasting - so pasting in to A- E)?
Click to expand...
Close, your range reference needs to look like this:
Code: 
    Range("A" & Target.Row & ",AP" & Target.Row & ":AS" & Target.Row)
 
Upvote 0
Joe,
Your code is trowing up some odd results. It works on the fist line (Row 2), it adds the information to the 'breakfast' and 'snacks' sheet as expected. But when I add a new row (row 3) and ask it to copy to 'Dinner' and 'Lunch' it seems to copy the information from row 2. Odd?
 
Upvote 0
Hi Joe,
I can see where it's going wrong and it's not the code. That's happening is it's copying and pasting the formula in the cell rather than the actual value (which I guess I should have mentioned).
Is there a way to copy/paste the value instead of the formula?
 
Upvote 0
You must log in or register to reply here.

Similar threads

gymwrecker
  • Solved
Formula to copy data from one sheet to another sheet based on specific criteria
Replies
4
Views
143
Fluff
Fluff
P
  • Question Question
Pick lines and copy depends to another cell sheet
Replies
2
Views
83
rowebca
rowebca
D
  • Solved
VBA to copy only matching data from 2 csv workbooks into the "MasterCSV"
2
Replies
18
Views
925
Peter_SSs
Peter_SSs
D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
329
RoryA
RoryA
Q
  • Question Question
Macro needed to insert 4 rows in table, copy data from above, copy data from another sheet and paste special (transpose values) to those new rows...re
Replies
1
Views
271
sijpie
sijpie

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top