copy all sheets to a summary sheet but

I am using the below code to copy data from each sheet onto a summary sheet, but, I have two problems.

1. Some of the sheets do not have any data in column B [except the header] which means that when the next sheet copies the data onto the summary sheet it overwrites the the data where there is nothing in 'B'

2. Each sheet has a header but I only want to copy the header from the first sheet onto the summary sheet.

Can an expert help me out with this so that all the sheets are copied onto the summary sheet and nothing gets overwritten.

Many thanks

Dim ws As Worksheet
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets("Summary").Activate
     
    For Each ws In Worksheets
        If ws.Name <> "Summary" Then
            ws.Range("B2:U65000").Copy
            ActiveSheet.Paste Range("B65536").End(xlUp).Offset(1, 0)
        End If
    Next ws
   
    Application.ScreenUpdating = True
JagwarmanAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
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.

Saurabh Singh TeotiaCommented:
Few questions i have...

1. Which row has your header rows??
2. What happens when you run the macro next time since their is already data in summary1 basis of the earlier macro which you just ran..Do you want to clear that or want to paste below then that?
3. Also the range you want to copy is B Column to U Column..starting from row-2??

Saurabh...
0
JagwarmanAuthor Commented:
Hi Saurabh Singh Teotia

1. Which row has your header rows?? Row 1

2. What happens when you run the macro next time since their is already data in summary1 basis of the earlier macro which you just ran..Do you want to clear that or want to paste below then that? When it runs next time clear Summary Sheet at start of process.

3. Also the range you want to copy is B Column to U Column..starting from row-2?? B2 to U where ever the last row is.so B2-U500 or B2-U5000 [changes all the time]

Thanks
0
Saurabh Singh TeotiaCommented:
Use this code...

Sub MOVEDATA()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Set ws1 = Sheets("Summary")

    ws1.Cells.Clear


    For Each ws In ActiveWorkbook.Worksheets

        If ws.Name <> ws1.Name Then

            If Application.WorksheetFunction.CountA(ws1.Range("1:1")) = 0 Then
                lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws.Range("B1:U" & lrow).Copy ws1.Range("B1")
            Else
                lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                ws.Range("B2:U" & lrow).Copy ws1.Range("B" & lr)
            End If
        End If

    Next ws
End Sub

Open in new window


Saurabh...
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
Build an E-Commerce Site with Angular 5

Learn how to build an E-Commerce site with Angular 5, a JavaScript framework used by developers to build web, desktop, and mobile applications.

Roy CoxGroup Finance ManagerCommented:
Edit: this is an amended version

This is code that I use.

'---------------------------------------------------------------------------------------
' Module    : Module1
' DateTime  : 09/05/2007 08:43
' Author    : Roy Cox (royUK)
' Website   : www.excel-it.com for more examples and Excel Consulting
' Purpose   : combine data from multiple sheets to one
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.

'---------------------------------------------------------------------------------------
Option Explicit

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Dim DataRng As Range
    Dim Rw As Long

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> ActiveSheet.Name Then
            Rw = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            If Rw = 1 Then
                Set DataRng = ws.Cells(1, 1).CurrentRegion
                DataRng.Copy ActiveSheet.Cells(Rw, 1)
            Else: Rw = Rw + 1
                'don't copy header rows
                DataRng.Offset(1, 0).Resize(DataRng.Rows.Count - 1, _
                                            DataRng.Columns.Count).Copy ActiveSheet.Cells(Rw, 1)
            End If
        End If
    Next ws

End Sub
0
JagwarmanAuthor Commented:
Thanks Roy but that does what my original does which is to overwrite when 'B' is blank
0
JagwarmanAuthor Commented:
Hi Saurabh Singh Teotia

That's great thanks. It includes all the headers but I can live with that.
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.