VBA Copy Paste Multiple Sheet to one Master Sheet

[SuperMan02]

Hello Everyone,

I would like to ask an assistance, I am new in scripting VBA and I need help on how I can transfer all the data from multiple sheets to one Master sheet in the Excel File.

I have 6 Sheets where I'll get the data and the data are in Range A7:K16 (this range applies to all the sheet). Not all rows are filled out, it will always depend if we received data from certain Accounts. I would like to transfer all of the data in the Master File wherein if the row are blank the next sheet will be paste in the master file in the next blank row.

Hope someone can help me and I truly appreciate your time.

 

[sergioMabres]

Hi Super,
Every day there are tenths of question for consolidation, most of then get unanswered, because the question has been answered many times before.
These kinds of macros do more or less the same thing, only file names, sheets names and ranges change, some time condition like copy rows only if column A has a value of 1.
Here is a VBA from a question yesterday adapted to your ranges, I do not know your file names or sheet names so I improvised, I guessed the Master sheet name is Master

Sub TranferAllData()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim cWkb As Workbook
Dim ws As Worksheet
Dim answer As Integer
Dim lr As Long, lr2 As Long, r As Long
Dim rc As Object

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

answer = MsgBox("Would you like to transfer all data?", vbYesNo + vbQuestion, "Confirmation")

If answer = vbYes Then
Set cWkb = Application.ActiveWorkbook
lr2 = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
    ' Change to the path you will use to idetify the file you wanto to transfer to Master
    Path = "... your path for the files to transfer ..."
    FileName = Dir(Path & "\*.xls*", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & FileName)
        For Each ws In Wkb.Worksheets
            For r = 7 To 16 Step 1
                If ws.Range("A" & r).Value <> "" Then
                    ws.Range(Cells(r, 1), Cells(r, 11)).Copy Destination:=cWkb.Sheets("SummaryAccrual").Range("A" & lr2 + 1)
                    lr2 = cWkb.Sheets("SummaryAccrual").Cells(Rows.Count, "A").End(xlUp).Row
                End If
            Next r
        Next ws
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
End If
End Sub

Cheers
Sergio

 

[SuperMan02]

Hello Sergio,

Appreciate your help on this however it the code doesn't work. So I have Sheet1, Sheet2, Sheet3, Sheet4, Sheet5 and Sheet6 and I need to transfer the data in Range A7:K16 of All Sheets to a Sheet name Master. Not All Cell in Range A7:K16 are filled out which means we need to have a VBA Code - Range("A" & Rows.Count).End(xlUp).Offset(1).Select so that whenever Sheet1 have blank rows Sheet 2 data will be paste in the next blank row in Sheet named Master.

In pasting the data in Sheet Master it should start in Row 6

Hi Super,
Every day there are tenths of question for consolidation, most of then get unanswered, because the question has been answered many times before.
These kinds of macros do more or less the same thing, only file names, sheets names and ranges change, some time condition like copy rows only if column A has a value of 1.
Here is a VBA from a question yesterday adapted to your ranges, I do not know your file names or sheet names so I improvised, I guessed the Master sheet name is Master

Sub TranferAllData()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim cWkb As Workbook
Dim ws As Worksheet
Dim answer As Integer
Dim lr As Long, lr2 As Long, r As Long
Dim rc As Object

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

answer = MsgBox("Would you like to transfer all data?", vbYesNo + vbQuestion, "Confirmation")

If answer = vbYes Then
Set cWkb = Application.ActiveWorkbook
lr2 = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row
    ' Change to the path you will use to idetify the file you wanto to transfer to Master
    Path = "... your path for the files to transfer ..."
    FileName = Dir(Path & "\*.xls*", vbNormal)
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & FileName)
        For Each ws In Wkb.Worksheets
            For r = 7 To 16 Step 1
                If ws.Range("A" & r).Value <> "" Then
                    ws.Range(Cells(r, 1), Cells(r, 11)).Copy Destination:=cWkb.Sheets("SummaryAccrual").Range("A" & lr2 + 1)
                    lr2 = cWkb.Sheets("SummaryAccrual").Cells(Rows.Count, "A").End(xlUp).Row
                End If
            Next r
        Next ws
        Wkb.Close False
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
End If
End Sub

Cheers
Sergio

 

[Michael M]

assuming the Master sheet is called "Master", try

Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
    If ws.Name <> "Master" Then
        ws.Range("A7:K16").Copy Sheets("Master").Range("A" & lr)
        lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
Next ws
End Sub

 

[sergioMabres]

If empty cells is the problem change the macro
First time you set lr2 use: lr2=1
and second time instead of lr2 = cWkb.Sheets("SummaryAccrual").Cells(Rows.Count, "A").End(xlUp).Row
use lr2=lr2+10
Cheers
Sergio

 

[SuperMan02]

Hello Sergio - Appreciate your help on this but the code is not working I am not sure why

Hello Michael,

The Code Work! Eureka! I would like to know if I wanted to paste the data starting Column N, is this the right code? I also wanted to know if the VBA in Columns A - M (the code that you first posted) will be affected if I have another table to VBA in Columns N onward? Thank You!!!!

Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Master").Cells(Rows.Count, "N").End(xlUp).Row + 1
For Each ws In Worksheets
    If ws.Name <> "Master" Then
        ws.Range("A7:K16").Copy Sheets("Master").Range("N" & lr)
        lr = Sheets("Master").Cells(Rows.Count, "N").End(xlUp).Row + 1
    End If
Next ws
End Sub

assuming the Master sheet is called "Master", try

Sub MM1()
Dim ws As Worksheet, lr As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
    If ws.Name <> "Master" Then
        ws.Range("A7:K16").Copy Sheets("Master").Range("A" & lr)
        lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
Next ws
End Sub

 

[SuperMan02]

One last question, what is the code that I need to add if I wanted to add a condition wherein if the data in Column B is = "No", the entire row will not be included in pasting it to Master sheet and in what part of the code should I add it? I really appreciate all your help I am almost done with my task and that's because of you guys. Thank You!!!

 

[Michael M]

Try this.....UNTESTED

Sub MM1()
Dim ws As Worksheet, lr As Long, r As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
    If ws.Name <> "Master" Then
     ws.Activate
     For r = 7 To 16
        If Range("B" & r).Value <> "No" Then
        Rows(r).Copy Sheets("Master").Range("A" & lr)
        lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
    Next r
    End If
Next ws
End Sub

 

[SuperMan02]

Hello Michael,

I encounter a debug message when I am trying to run the code. The debug starts in this code Rows(r).CopySheet("Master")

I am not sure if it's because I gave the wrong sequence.

I needed to copy all sheet range A22:L31 in "Master" Column N:Y but the condition is if the row data in Column L of every sheet is "No" it should not be included in the rows that will be paste in the Master sheet.

Sub MM1()
Dim ws As Worksheet, lr As Long, r As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
If ws.Name <> "Master" Then
ws.Activate
For r = 7 To 16
If Range("B" & r).Value <> "No" Then
Rows(r).Copy Sheets("Master").Range("A" & lr)
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Next r
End If
Next ws
End Sub

 

[Michael M]

I'm confused.....
we were copying from columns A to K with the criteria in col B......now it's A to L with the criteria in L ?????

Can you clearly describe what you REALLY want to do ????