Automatically Copy rows to different sheets

[Rurkz]

Hey my first time on here and I'm kinda new to excel so go easy on me lol

I'm basically trying to figure how to copy a row from sheet1 to the next available row in sheet2 and sheet3 if 2 criterias are met.

Ok so for sheet1 to sheet 2

I have a column name for "date paid" in row "F3" to "F33"

And

A column name for "date collected" in row "H3" to "H33"

So when "date paid" cell is "empty" and the "date collected" cell is "filled", I want that row to be automatically copied to the next available rows in spread sheet 2.

2nd part

Pretty much want to do the same from spread sheet 1 to spread 3

But use column "overweight fee" in row "L3" to "L33"

When these cells are filled in, I want it to be automatically copied to the next available rows to sheet 3.

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your Sheet1 and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter data in column H or column L and press the RETURN key or TAB key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H:H,L:L")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Select Case Target.Column
        Case Is = 8
            If Target.Offset(, -2) = "" Then
                Target.EntireRow.Copy Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1)
            End If
        Case Is = 12
            If Target.Offset(, -6) = "" Then
                Target.EntireRow.Copy Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1)
            End If
    End Select
    Application.ScreenUpdating = True
End Sub

 

[Rurkz]

Hey thanks for getting back to me

I'm getting a compile error

And this is highlighted in yellow

"Private Sub Worksheet_Change(ByVal Target As Range)"

 

[Rurkz]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your Sheet1 and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter data in column H or column L and press the RETURN key or TAB key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H:H,L:L")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Select Case Target.Column
        Case Is = 8
            If Target.Offset(, -2) = "" Then
                Target.EntireRow.Copy Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1)
            End If
        Case Is = 12
            If Target.Offset(, -6) = "" Then
                Target.EntireRow.Copy Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "A").End(xlUp).Offset(1)
            End If
    End Select
    Application.ScreenUpdating = True
End Sub

Hey thanks for getting back to me

I'm getting a compile error

And this is highlighted in yellow

"Private Sub Worksheet_Change(ByVal Target As Range)"

 

[mumps]

When I tested the macro on a dummy file, it worked properly. A compile error can be caused by many things. What was the full error message? Can you possibly upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[Rurkz]

When I tested the macro on a dummy file, it worked properly. A compile error can be caused by many things. What was the full error message? Can you possibly upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

here you go!

Bin Tracker.xlsx

Shared with Dropbox

www.dropbox.com

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H:H,L:L")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim lRow As Long
    Select Case Target.Column
        Case Is = 8
            With Sheets("Outstanding Bins")
                lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1
                If Target.Offset(, -2) = "" Then
                    Target.EntireRow.Copy .Range("A" & lRow)
                End If
            End With
        Case Is = 12
            With Sheets("Overweight Bins")
                lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1
                If Target.Offset(, -6) = "" Then
                    Target.EntireRow.Copy .Range("A" & lRow)
                End If
            End With
    End Select
    Application.ScreenUpdating = True
End Sub

 

[Rurkz]

Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("H:H,L:L")) Is Nothing Then Exit Sub Application.ScreenUpdating = False Dim lRow As Long Select Case Target.Column Case Is = 8 With Sheets("Outstanding Bins") lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1 If Target.Offset(, -2) = "" Then Target.EntireRow.Copy .Range("A" & lRow) End If End With Case Is = 12 With Sheets("Overweight Bins") lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1 If Target.Offset(, -6) = "" Then Target.EntireRow.Copy .Range("A" & lRow) End If End With End Select Application.ScreenUpdating = True End Sub

hey it worked!!! appreciate it man, i may bug you again with some other ideas i want to try!!!!

 

[Rurkz]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("H:H,L:L")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim lRow As Long
    Select Case Target.Column
        Case Is = 8
            With Sheets("Outstanding Bins")
                lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1
                If Target.Offset(, -2) = "" Then
                    Target.EntireRow.Copy .Range("A" & lRow)
                End If
            End With
        Case Is = 12
            With Sheets("Overweight Bins")
                lRow = .Columns(1).Find("*", After:=Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row + 1
                If Target.Offset(, -6) = "" Then
                    Target.EntireRow.Copy .Range("A" & lRow)
                End If
            End With
    End Select
    Application.ScreenUpdating = True
End Sub

i have another question, i have an expense sheet that some how replaces the letters of the columns to the names only when you scroll down pass them, iv been searching everyhere and all i found was the option to switch them to numbers

 

[mumps]

I'm not sure what you mean. Does your question refer to the workbook you uploaded? If so, explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data. Also, to avoid clutter, please click the "Reply" button not the "+Quote" button when responding.