Copy/move rows beween sheets when date field is populated

**TCLUTE** · 07-22-2013, 03:49 PM

I have combed through the forum for the past 2 days, and cannot locate what I need [/i] or if I did - I did not understand it to realize)[/i].

I am using Excel 2010. I have an Employee List Workbook that I modify to link to an Access database. Each month, an updated list is sent to me that I modify, and then replace the existing info. I also have a Terms sheet of terminations, with term date.

What I have done is place a TermDate column in my Employee List so I can insert dates of termination before updating the workbook.

I would like all rows in the Employee List (sheet: 03 07 201) with a term date moved to the (sheet: Terms), on the next available row. If the information needs to transfer/copy on close, or save, that would be fine. I am not concerned with removing the rows from the Employee List as they will be replaced with the updated list. I have attached sample files for both.

PURPOSE: The term date file I receive contains info not needed. My plan is to create a query in access to combine the 2 files in order to keep my database complete. Therefore both workbooks are set up the same manner..

As you can tell by looking at the Macro's I created, I am rather inexperienced with this. Any assistance would be greatly appreciated. Thank You.

**jaslake** · 07-28-2013, 03:46 PM

Hi TCLUTE

Welcome to the Forum!

I'm not at all sure what you're trying to do...I've guessed with the Code in the attached. Please note, the Worksheet Tab Order is essential. Run the Code from the button...let me know of issues.

Option Explicit

Sub Move_Terms()
    Dim ws1 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
    Dim LR1 As Long, LR3 As Long, LR3x As Long, NR4 As Long
    Dim Rng1 As Range, Rng3 As Range, cel As Range
    Dim FindMe As String
    Dim x As Long
    Set ws1 = Sheets(1)
    Set ws3 = Sheets(3)
    Set ws4 = Sheets(4)

    With ws4
        NR4 = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    End With

    With ws3
        LR3x = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        LR3 = .Range("A" & .Rows.Count).End(xlUp).Row

        'Delete extraneous stuff from Sheet(3)
        If Not LR3x = LR3 Then
            .Range(.Cells(LR3 + 1, 1), .Cells(LR3x, 1)).EntireRow.Delete
        End If
    End With

    With ws1
        LR1 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
        .Range("A1:I" & LR1).AutoFilter Field:=9, Criteria1:="<>"
        Set Rng1 = .Range(.Cells(2, 1), .Cells(LR1, 1)).SpecialCells(xlCellTypeVisible)
        For Each cel In Rng1
            FindMe = cel.Value
            With ws3.Range("A2:A" & LR3)
                Set Rng3 = .Find(What:=FindMe, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
                If Not Rng3 Is Nothing Then
                    Rng3.Offset(0, 8).Value = cel.Offset(0, 8).Value
                End If
            End With
        Next cel
        .AutoFilterMode = False
    End With
    With ws3
        .Range("A1:I" & LR3).AutoFilter Field:=9, Criteria1:="<>"
        Set Rng3 = .AutoFilter.Range
        x = Rng3.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        If x >= 1 Then
            .AutoFilter.Range.Offset(1, 0).Copy
            ws4.Cells(NR4, 1).PasteSpecial
            Application.CutCopyMode = False
            .AutoFilterMode = False
        End If
    End With
End Sub