If sheet name contains specific text select range and paste to another ws

[jsayers2869]

Need help building a code. I want to search all worksheets in a workbook that contain a specific string in its sheet name to copy cell data of a range and paste as values into a different ws.

What I ultimately need to do is take data from A2 of all BL ws and paste into Column A of Summary ws. Then take A1 of all SL ws and paste into Column B of Summary ws. I would need to paste as values. My sheets are named 1-15 as BL, SL (BL1, SL1, BL2, SL2, BL3, SL3, ect) and a Summary ws.

 

[Trebor76]

Hi jsayers2869,

Welcome to MrExcel!!

Try this:

Option Explicit
Sub Macro1()

    Dim wsSumm As Worksheet, ws As Worksheet
    Dim strCol As String
    Dim lngRow As Long
    
    Application.ScreenUpdating = False
    
    Set wsSumm = ThisWorkbook.Sheets("Summary") '<-Sheet name for the data to be concolidated. Change to suit.
    
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> wsSumm.Name Then
            strCol = IIf(StrConv(Left(ws.Name, 2), vbUpperCase) = "BL", "A", "B")
            lngRow = IIf(StrConv(Left(ws.Name, 2), vbUpperCase) = "BL", 2, 1)
            wsSumm.Range(strCol & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Range("A" & lngRow)
        End If
    Next ws
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[jsayers2869]

Hi jsayers2869,

Welcome to MrExcel!!

Try this:

Option Explicit
Sub Macro1()

    Dim wsSumm As Worksheet, ws As Worksheet
    Dim strCol As String
    Dim lngRow As Long
   
    Application.ScreenUpdating = False
   
    Set wsSumm = ThisWorkbook.Sheets("Summary") '<-Sheet name for the data to be concolidated. Change to suit.
   
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> wsSumm.Name Then
            strCol = IIf(StrConv(Left(ws.Name, 2), vbUpperCase) = "BL", "A", "B")
            lngRow = IIf(StrConv(Left(ws.Name, 2), vbUpperCase) = "BL", 2, 1)
            wsSumm.Range(strCol & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Range("A" & lngRow)
        End If
    Next ws
   
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

Thank you so much for taking the time to put this together. I did try running this and I get an Run-Time error '9' subscript out of range. It highlights Set wsSumm = ThisWorkbook.Sheets("Summary") as the reasoning. I have a Summary tab so I am unsure why it is giving this error.

 

[Trebor76]

Thank you so much for taking the time to put this together. I did try running this and I get an Run-Time error '9' subscript out of range. It highlights Set wsSumm = ThisWorkbook.Sheets("Summary") as the reasoning. I have a Summary tab so I am unsure why it is giving this error.

That error message usually appears when a sheet that is being referenced is not exactly as you see it.
To check, select a blank cell on any other sheet and reference cell A1 of the Summary tab. The reference to sheet in the formula will show how the tab needs to be referenced in the code (at a guess I'd say there's a space in the name. If so Excel will put a single quote around the sheet name in the formula).