Copying Data From Multiple Worksheets into Single Worksheet - Macro not working

[NaveyWestside]

Hello Everyone!

I'm trying to copy data from 30 worksheets and paste it into a master worksheet (within the same workbook).

The range from each worksheet I wish to copy is (A4:R8). Eventually, the master worksheet should have the data in columns A to R from every worksheet.

Copied below is a macro I found online, which I've tried to use. However, the problem is that the data from every worksheet is not getting picked up. For some reason it's only copying the data from the last worksheet in the workbook and ignoring every other worksheet (e.g. out of 30 worksheets, the macro is only picking up data from Sheet 30 and ignoring Sheets 1-29). Perhaps it's a looping issue? I was wondering if someone could please help me edit the <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> code below so data can get extracted from every worksheet within the workbook. I'm really new to <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> and would really appreciate any help! Thanks so much!


Sub DataPull2()
Dim Late As Range, ws As Worksheet, ns As Worksheet
For Each ws In Worksheets
If ws.Name <> "Variable" Then
Set Late = ws.Range("R1:AA4")

' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

' Add a new summary worksheet.
Set ns = ActiveWorkbook.Worksheets.Add
ns.Name = "RDBMergeSheet"

' Specify the range to place the data.
Set CopyRng = ws.Range("R1:AA4")

' This statement copies values and formats from each
' worksheet.
CopyRng.Copy
With ns.Cells(First + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With

End If
Next ws
End Sub

 

[Imabus]

Every time the loop runs you are deleting the Summary sheet.

ActiveWorkbook.Worksheets("RDBMergeSheet").Delete

Then you are remaking it

Set ns = ActiveWorkbook.Worksheets.Add
ns.Name = "RDBMergeSheet"

Then pasting in your data into the new sheet

With ns.Cells(First + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
End With

It looks like you need to move your delete\recreate sheet before the loop.

Also you have not set the variable First to anything to let the code know what row to paste your data, so it will default to pasting it into A1 every time.

 

[Imabus]

Untested code alert!

Not the most efficient but mostly butchered from yours....

Sub DataPull2()
Dim Late As Range, ws As Worksheet, ns As Worksheet


'delete summary sheet if found
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True


' Add a new summary worksheet.
Set ns = ActiveWorkbook.Worksheets.Add
ns.Name = "RDBMergeSheet"


For Each ws In Worksheets
    If ws.Name <> "Variable" Then
        Set Late = ws.Range("R1:AA4")
        Late.Copy
        first = ns.Cells(ns.Rows.count, "A").End(xlUp).Row + 1
        With ns.Cells(first + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
    End If
Next ws
End Sub

 

[NaveyWestside]

Working perfectly now, it's pulling the data from all tabs. Thanks so much for your help, really appreciate it!

Untested code alert!

Not the most efficient but mostly butchered from yours....

Sub DataPull2()
Dim Late As Range, ws As Worksheet, ns As Worksheet


'delete summary sheet if found
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True


' Add a new summary worksheet.
Set ns = ActiveWorkbook.Worksheets.Add
ns.Name = "RDBMergeSheet"


For Each ws In Worksheets
    If ws.Name <> "Variable" Then
        Set Late = ws.Range("R1:AA4")
        Late.Copy
        first = ns.Cells(ns.Rows.count, "A").End(xlUp).Row + 1
        With ns.Cells(first + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
    End If
Next ws
End Sub