Forum Discussion

JMcAnarney's avatar
JMcAnarney
Copper Contributor
Feb 06, 2024

Writing a Macro to Combine Specific Sheets

We are trying to write a macro to combine data on multiple sheets throughout a workbook.  We are having trouble because we cannot figure out how to omit certain pages of the book.  For example we wan...
Macros and VBA
JMcAnarney's avatar
JMcAnarney
Copper Contributor
Feb 07, 2024

JKPieterse 

 

Thanks I am trying to get it where it just does the values like the following:

 

Thanks I tried to do it like the following since there are many sheets and many rows of data:

Sub CombineData()

Dim ws As Worksheet, Nws As Worksheet

If Evaluate("isref('Data'!B2)") Then
Set Nws = Sheets("Data")
Else
Set Nws = Sheets.Add(Sheets(1))
Nws.Name = "Data"
End If
For Each ws In Worksheets
If ws.Name <> "Data" And ws.Name <> "Workforce File" Then
Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(95, 200).Value = ws.Range("b2:cq295").Value
End If
Next ws
End Sub

Basically I want it too combine all the data in in columns A to CQ all the way down it only combines about half of the data I attached a sample workbook to where the highlight tabs are the ones where I want all the data combined and I want to switch the script up to where it is slecting sheets I DO want as opposed to the negatives.  In this case I Want police and fire and general ftes

 

appreciate the help

 

 

JKPieterse's avatar
JKPieterse
Silver Contributor
Feb 08, 2024

JMcAnarney Here's your macro catering for including headings and for the different worksheet sizes

 

Sub CombineData()
    Dim ws As Worksheet, Nws As Worksheet
    Dim data As Variant
    Dim hasHeaders As Boolean
    If Evaluate("isref('Data'!B2)") Then
        Set Nws = Sheets("Data")
        hasHeaders = True
    Else
        Set Nws = Sheets.Add(Sheets(1))
        Nws.Name = "Data"
    End If
    For Each ws In Worksheets
        If ws.Name <> "Data" And ws.Name <> "Workforce File" Then
            If hasHeaders Then    'first time we want the header row
                data = ws.UsedRange.Offset(1).Value2
            Else
                data = ws.UsedRange.Value2
            End If
            If IsArray(data) Then    'Sheet might be empty!
                If hasHeaders Then
                    Nws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(data, 1), UBound(data, 2)).Value = data
                Else
                    Nws.Range("A" & Rows.Count).End(xlUp).Resize(UBound(data, 1), UBound(data, 2)).Value = data
                End If
                hasHeaders = True    'No more headers needed
            End If
        End If
    Next ws
End Sub

 

Resources