Excel VBA to append rows from one sheet to another

In Sheet1 thru Sheet3, I have some data that starts from cell A12.  I need some sort of loop code that will start with Sheet1, copy all the data starting from A12, and then paste it into cell A2 on worksheet named "AppendedResults".

Then it will loop to Sheet2, copy all the data starting from A12, and then paste it into the row directly below the last row where Sheet1 results were pasted.  

Then it would repeat the same step for Sheet3.  Please see my attached file for an example of the data.  Thanks for any help! =)




ExampleAppend.xls
KP_SoCalAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Chris BottomleySoftware Quality Lead EngineerCommented:
If the source sheets are only populated in teh range row 12 on then try:

Chris
Sub appSh()
Dim sh As Worksheet
Dim tgtSheet As Worksheet
Dim rng As Range

    Set tgtSheet = ThisWorkbook.Sheets("appendedresults")
    tgtSheet.Cells.Delete
    For Each sh In ThisWorkbook.Worksheets
        If LCase(sh.Name) <> LCase(tgtSheet.Name) Then
            Set rng = tgtSheet.Range("a" & tgtSheet.Rows.Count).End(xlUp).Offset(1, 0)
            If rng.Row < 2 Then Set rng = tgtSheet.Range("a2")
            sh.UsedRange.Copy rng
        End If
    Next
End Sub

Open in new window

0
DaveCommented:
hth

Dave
0
DaveCommented:
Chris was in first, but missing code attached for completeness

Sub AppendMe()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Set ws1 = ThisWorkbook.Sheets("AppendedResults")
    For Each ws2 In ThisWorkbook.Sheets
        If ws2.Name <> ws1.Name Then
            'Skip importing target sheet data if the source sheet is blank
            Set rng2 = ws2.Range(ws2.[a12], ws2.[a12].End(xlDown).End(xlToRight))
            If Not rng2 Is Nothing Then
                Set rng1 = ws1.Cells.Find("*", ws1.[a1], xlValues, , xlByRows, xlPrevious)
                'Find the first blank row on the target sheet
                If Not rng1 Is Nothing Then
                    ws2.UsedRange.Copy ws1.Cells(rng1.Row + 1, ws2.UsedRange.Cells(1).Column)
                Else
                    'target sheet is empty so copy to first row
                    ws2.UsedRange.Copy ws1.Cells(1, ws2.UsedRange.Cells(1).Column)
                End If
            End If
        End If
    Next ws2
End Sub

Open in new window

0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Chris BottomleySoftware Quality Lead EngineerCommented:
If you need to eexclude raows 1:11 then the following minor tweak should do that ... at the expense of being slighly less easy to follow.

Chris
Sub appSh()
Dim sh As Worksheet
Dim tgtSheet As Worksheet
Dim srcRange As Range
Dim rng As Range

    Set tgtSheet = ThisWorkbook.Sheets("appendedresults")
    tgtSheet.Cells.Delete
    For Each sh In ThisWorkbook.Worksheets
        If LCase(sh.Name) <> LCase(tgtSheet.Name) Then
            Set rng = tgtSheet.Range("a" & tgtSheet.Rows.Count).End(xlUp).Offset(1, 0)
            If rng.Row < 2 Then Set rng = tgtSheet.Range("a2")
            Set srcRange = Intersect(sh.Range("a12:A" & sh.Rows.Count).EntireRow, sh.UsedRange)
            srcRange.Copy rng
        End If
    Next
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
sstampfCommented:
If you just want to copy data from sheet 1, 2 and 3 and not all the sheets then you can also use the code below:
Sub test()
Dim sht As Worksheet
Sheets("AppendedResults").Cells.Delete
For i = 1 To 3
Set sht = Sheets("Sheet" & i)
LastRow = sht.Range("A" & Rows.Count).End(xlUp).Row
sht.Range("A12:IV" & LastRow).Copy
Sheets("AppendedResults").Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Next i
End Sub

Open in new window

0
KP_SoCalAuthor Commented:
Thanks everyone of the quick responses on these.  Below is the code I would like to impliment but I get an error requesting me to define variable for "LastRow".  Does anyone have any ideas how to correct this?  You'll notice that it's a spin off from sstampf's code, which I annoted below in the code window.

Dim WS As Worksheet
Sheets("AppendResults").Cells.Delete


For Each WS In ActiveWorkbook.Worksheets
    If UCase(WS.Name) Like "*SERIES*" And UCase(WS.Range("A1").Value) = "RETURN" Then
       
        LastRow = WS.Range("A" & Rows.Count).End(xlUp).Row
        WS.Range("A12:IV" & LastRow).Copy
        Sheets("AppendResults").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
       
Next WS
End Sub
Sub test() 
Dim sht As Worksheet 
Sheets("AppendedResults").Cells.Delete 
For i = 1 To 3 
Set sht = Sheets("Sheet" & i) 
LastRow = sht.Range("A" & Rows.Count).End(xlUp).Row 
sht.Range("A12:IV" & LastRow).Copy 
Sheets("AppendedResults").Select 
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select 
ActiveSheet.Paste 
Next i 
End Sub

Open in new window

0
TracyVBA DeveloperCommented:
If you're getting that message, then you have Option Explicit turned on.

Add this to the top

Dim lastRow as long
Sub test()  
Dim sht As Worksheet  
Dim lastRow as Long
Sheets("AppendedResults").Cells.Delete  
For i = 1 To 3  
Set sht = Sheets("Sheet" & i)  
LastRow = sht.Range("A" & Rows.Count).End(xlUp).Row  
sht.Range("A12:IV" & LastRow).Copy  
Sheets("AppendedResults").Select  
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select  
ActiveSheet.Paste  
Next i  
End Sub

Open in new window

0
KP_SoCalAuthor Commented:
Uuuggh, *smile*, thanks broomee9, that was all I need to do.  I'm up and running.  Thanks again everyone! =)
0
KP_SoCalAuthor Commented:
If anyone is still monitoring this thread, I posted a closely related question to it on this link...
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_25737512.html?fromWizard=true
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.