PDA

View Full Version : Create Summary sheet from multiple tabs & run macro on certain tabs



amandacipra
04-23-2019, 12:43 PM
I hate having to post things here that I feel like I should be able to google - but I swear I have wasted half a day trying to figure this out.
I'm trying to do 2 things - run my formatting macro on all worksheets that have "Budget Comparison" in A2.
Secondly, create a summary sheet that gives me Row 1 of all worksheets with BC in A2 and any lines that have been highlighted on those worksheets through conditional formatting. If I need to add a column that shows which rows that includes, I'm ok with that too. (A summary sheet for managers of all variances that need to be explained in up to 20 sheets so they are all summarized in one place).

I've created a sample worksheet with a Summary page which is what I would like it to look like as well as 2 tabs that should pull into the Summary and one that should not.
:crying:24128
Thank you so much to anyone that can help me! I promise I'm learning from these and not just copying and pasting!

Logit
04-24-2019, 02:15 PM
.
Here is one method :



Option Explicit


Sub cpySummary()


Dim i As Long
Dim j As Long
Dim LR As Long

Application.ScreenUpdating = False

For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Name <> ("Summary Sheet") Then

Sheets(i).Range("$A$1:$A$100").AutoFilter Field:=1, Criteria1:=RGB(216, 216, 216), Operator:=xlFilterCellColor

Sheets(i).Range("$A$1:$A$100").AutoFilter Field:=1, Criteria1:=RGB(255, 255, 204), Operator:=xlFilterCellColor

End If
Next

Dim wsM As Worksheet
Set wsM = Sheets("Summary Sheet")


j = 1 ' Start copying to row 1 in target sheet
LR = Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Name <> ("Summary Sheet") Then
If Sheets(i).Range("A2").Value = "Budget Comparison" Then
Sheets(i).Range("A1").Copy Destination:=wsM.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Sheets(i).Range("A5:I5").Copy Destination:=wsM.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Sheets(i).UsedRange.Offset(1).Copy Destination:=wsM.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
wsM.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = " "
j = j + 1
End If

End If

Next i

For i = 1 To ThisWorkbook.Sheets.Count
On Error Resume Next
If Sheets(i).AutoFilterMode Then
Sheets(i).AutoFilterMode = False
End If
Next
wsM.Columns("A:M").EntireColumn.AutoFit
wsM.Range("A1").Select

Application.ScreenUpdating = True
End Sub


Sub delRows()
Dim wsM As Worksheet


Set wsM = Sheets("Summary Sheet")
wsM.Rows("2:1000").Delete
End Sub