Transfer Data to another sheet automatically

**jmisti2** · 06-21-2012, 09:41 AM

Hi new here. Looking for some help. I've found other threads on the subject, but I guess I'm not Excel savy enough to interpret the code and change the necessary variables to what I need. I need to transfer a row of data from one sheet to another automatically when a certain criteria is met. I have attached my workbook here and explained my criteria.

I need for the row(s) starting at Row 4 through Row 39, columns A-P on Sheet(Engineering Schedule) to move to Sheet(Production Schedule) when the current date(Cell P2) > than the date in each row(s) respective cell E(E4,E5,E6,...E39).

Example: When P2>E4 move cells A4-P4 from Engineering Sheet to Production Sheet starting at first available row starting with Row 4. and so on.

The code currently on there was from another thread on the subject. I dont know if it will be a good base or not?

Project Production (TestCode).xlsm

**jmisti2** · 06-21-2012, 01:49 PM

Shameless bump to see if anyone can help??

**JBeaucaire** · 06-21-2012, 02:11 PM

There are people who only use the "unanswered threads" tool to get a list of posts with no replies. When you bump your own thread, you take your thread off that list permanently. FYI.

Anyway, in the vbeditor, insert a normal module (Insert > Module) and paste in the regular macro:

Option Explicit

Sub MoveData()
Dim RNG As Range, cell As Range, NR As Long

On Error Resume Next
With Sheets("Engineering Schedule")
    Set RNG = .Range("E:E").SpecialCells(xlConstants, 1)
    NR = Sheets("Production Schedule").Range("E" & Rows.Count).End(xlUp).Row + 1
    For Each cell In RNG
        If IsDate(cell) And cell < Now Then
            With .Range("A" & cell.Row).Resize(, 16)
                Sheets("Production Schedule").Range("A" & NR).Resize(, 16).Value = .Value
                NR = NR + 1
                .ClearContents
            End With
        End If
    Next cell
End With

End Sub

Now you can attach that to a button on your Engineering schedule, if you wish. Run it when you want to move the rows to the other sheet.

**jmisti2** · 06-21-2012, 02:36 PM

Thanks a bunch for the advice, and for the code. It works great!!!

One more question though. Is there a way to have the rows still containing data in the original sheet, after the extraction, consolidate at the top?

**JBeaucaire** · 06-21-2012, 03:14 PM

Like so... but you may want to take out the hardcoded color banding...replace with color banding applied through conditional formatting based on row #

Option Explicit

Sub MoveData()
Dim RNG As Range, cell As Range, NR As Long

On Error Resume Next
With Sheets("Engineering Schedule")
    Set RNG = .Range("E:E").SpecialCells(xlConstants, 1)
    NR = Sheets("Production Schedule").Range("E" & Rows.Count).End(xlUp).Row + 1
    For Each cell In RNG
        If IsDate(cell) And cell < Now Then
            With .Range("A" & cell.Row).Resize(, 16)
                Sheets("Production Schedule").Range("A" & NR).Resize(, 16).Value = .Value
                NR = NR + 1
                .ClearContents
            End With
        End If
    Next cell
    
    With .Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A4:A39"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A3:P39")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With

End Sub

**JBeaucaire** · 06-21-2012, 03:07 PM

Your sample data is pretty incomplete. I would think a real dataset would always have data in a particular column perhaps the first one. You should be able to add a "SORT" command at the bottom of the code that sorts that range of cells using the key column of your choosing, that would push the empty rows to the bottom of the range.