Copying Range From Multiple Worksheets Pasting Into One

[bennhrios9]

Can someone please help me copy a specific range from multiple worksheet and paste it into one worksheet? The worksheets are formatted identically. I need the ranges B11:B24 and C11:C24 of each worksheet to be pasted on a new worksheet. Also, I need D5 of each worksheet to replace C11 in the new worksheet.

 

[Zot]

How do you want range B11:B24 and C11:C24 from each worksheet to be copied into one sheet? Where and how you wanted those multiple ranges to be located?

 

[bennhrios9]

How do you want range B11:B24 and C11:C24 from each worksheet to be copied into one sheet? Where and how you wanted those multiple ranges to be located?

So, these two ranges of each sheet could just be next to each other going across the rows in the new worksheet. Looking like the screenshot below. (Example: B11:B24 and C11:C24 would be columns A and B in the new sheet.)

 

[Logit]

Sub CopyColumns()

Dim Source As Worksheet
Dim Destination As Worksheet
Dim Last As Long

Application.ScreenUpdating = False

Set Destination = Worksheets("Sheet1")

Destination.Name = "Sheet1"

'Looping through the worksheets in the workbook
For Each Source In ThisWorkbook.Worksheets
    
    
    If Source.Name <> "Sheet1" Then
        
        'Finding the last column from the destination sheet
        Last = Destination.Range("A1").SpecialCells(xlCellTypeLastCell).Column
        
        If Last = 1 Then
            'Pasting the data in the destination sheet
            Source.Range("B11:C24").Copy Destination.Columns(Last)
        Else
            Source.Range("B11:C24").Copy Destination.Columns(Last + 1)
        End If
    End If
Next

Columns.AutoFit

Application.ScreenUpdating = True

End Sub

The above will do what you are needing. However ... I don't understand the C5 - C11 request.

 

[bennhrios9]

Sub CopyColumns()

Dim Source As Worksheet
Dim Destination As Worksheet
Dim Last As Long

Application.ScreenUpdating = False

Set Destination = Worksheets("Sheet1")

Destination.Name = "Sheet1"

'Looping through the worksheets in the workbook
For Each Source In ThisWorkbook.Worksheets
   
   
    If Source.Name <> "Sheet1" Then
       
        'Finding the last column from the destination sheet
        Last = Destination.Range("A1").SpecialCells(xlCellTypeLastCell).Column
       
        If Last = 1 Then
            'Pasting the data in the destination sheet
            Source.Range("B11:C24").Copy Destination.Columns(Last)
        Else
            Source.Range("B11:C24").Copy Destination.Columns(Last + 1)
        End If
    End If
Next

Columns.AutoFit

Application.ScreenUpdating = True

End Sub

The above will do what you are needing. However ... I don't understand the C5 - C11 request.

Wow! Thank you so much! It worked, that's amazing.

 

[Zot]

This will loop through all sheets ans skip the sheet named "Summary" where the compiled data resides.
Add sheet name you want to skip.

Sub CollectData()

Dim n As Long
Dim ws As Worksheet, wsSummary As Worksheet

Application.ScreenUpdating = False

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Summary"
Set wsSummary = Sheets("Summary")

n = 0
For Each ws In ActiveWorkbook.Sheets
    Select Case ws.Name
        Case "Summary"
            ' Do Nothing if sheet name matches
        Case Else
            ws.Range("B11", "C24").Copy wsSummary.Range("A1").Offset(0, n)
            n = n + 2
    End Select
Next

End Sub

 

[snuffnchess]

What manipulations need to be done to the above code if instead of just a normal "Paste" a "Paste Value" is needed???

 

[Zot]

What manipulations need to be done to the above code if instead of just a normal "Paste" a "Paste Value" is needed???

I presumed you want to keep the number formatting

Sub CollectData()

Dim n As Long
Dim ws As Worksheet, wsSummary As Worksheet

Application.ScreenUpdating = False

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Summary"
Set wsSummary = Sheets("Summary")

n = 0
For Each ws In ActiveWorkbook.Sheets
    Select Case ws.Name
        Case "Summary"
            ' Do Nothing if sheet name matches
        Case Else
            ws.Range("B11", "C24").Copy
            wsSummary.Range("A1").Offset(0, n).PasteSpecial (xlPasteValuesAndNumberFormats)
            n = n + 2
    End Select
Next

End Sub