Find last row and copy, then paste to another worksheet

[mocephur]

Hi All,

I have a workbook with 4 worksheets, Sheet1, Sheet2, Sheet3 and WIP. I'm looking for a macro that can start at Sheet1 and copy from the 2nd row (the 1st row is my column headers) to the last row then, paste that data to WIP row2.

So, the data copied from Sheet1 goes to the WIP worksheet and then the data from Sheet2 goes to the WIP worksheet but below the data from Sheet1 and so on.

In essence all I'm doing is combining the data from Sheet1, Sheet2 and Sheet3 into the WIP worksheet. The problem that I have is the data in Sheets1-3 change daily, one day there will be 200 rows of data on one sheet and the next day 800 rows. Each Sheet varies with data on each day.

Help me gurus, you're my only hope!

 

[JoeMo]

I'm assuming you want to put a fresh combination of the three worksheets on the WIP worksheet each day.

Sub CopyToWIP()
Dim NxRow As Long
Dim Sht1 As Worksheet, Sht2 As Worksheet, Sht3 As Worksheet, WIP As Worksheet
Set Sht1 = Sheets("Sheet1"): Set Sht2 = Sheets("Sheet2"): Set Sht3 = Sheets("Sheet3"): Set WIP = Sheets("WIP")
Application.ScreenUpdating = False
WIP.UsedRange.Offset(1, 0).ClearContents
Sht1.UsedRange.Offset(1, 0).Copy WIP.Range("A2")
NxRow = WIP.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Sht2.UsedRange.Offset(1, 0).Copy WIP.Range("A" & NxRow)
NxRow = WIP.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Sht3.UsedRange.Offset(1, 0).Copy WIP.Range("A" & NxRow)
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With
End Sub

 

[mocephur]

I'm assuming you want to put a fresh combination of the three worksheets on the WIP worksheet each day.

Sub CopyToWIP()
Dim NxRow As Long
Dim Sht1 As Worksheet, Sht2 As Worksheet, Sht3 As Worksheet, WIP As Worksheet
Set Sht1 = Sheets("Sheet1"): Set Sht2 = Sheets("Sheet2"): Set Sht3 = Sheets("Sheet3"): Set WIP = Sheets("WIP")
Application.ScreenUpdating = False
WIP.UsedRange.Offset(1, 0).ClearContents
Sht1.UsedRange.Offset(1, 0).Copy WIP.Range("A2")
NxRow = WIP.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Sht2.UsedRange.Offset(1, 0).Copy WIP.Range("A" & NxRow)
NxRow = WIP.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
Sht3.UsedRange.Offset(1, 0).Copy WIP.Range("A" & NxRow)
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With
End Sub

That is OUTSTANDING! Works like a charm! Very much appreciated JoeMo

 

[JoeMo]

That is OUTSTANDING! Works like a charm! Very much appreciated JoeMo

You are welcome - thanks for the reply.