How to Copy and Append filtered data sourced from multiple sheets into a single destination sheet using a loop? - excel

Question

EDIT: I've pasted some revised code below in the Sub(Copyinternal) section. Still doesn't work but maybe I'm on the right track?
I have a workbook with 6 tabs. Sheets are set up as follows:
Controls
Forecast
Financial Update
Board Goals
Internal Calendar
External Calendar
Sheets 2-4 contain data tables that I would like to filter in two different ways and copy/paste to both tabs 5 & 6 without overwriting.
Sheets 5 & 6 have headers in row 1 that I would like to maintain.
Trying to:
First delete any existing information in "Internal Calendar" sheet and "External Calendar" sheet from Row 2 down without deleting the headers.
In "Forecast" sheet, filter column H on selections "Both" and "Internal" in and then copy/paste that information into "Internal Calendar" sheet starting in column C. I'm then trying to do the same for "Financial Update" and "Board Goals" sheets, but Copy/Pasting the filtered information after the content that's already been pasted into "Internal Calendar", as to not overwrite information.
Repeat step 2 except Filter H on "Both" and "External" and Copy/Paste the filtered info into "External Calendar" starting in column C.
Controls sheet can be ignored.
Loop begins to run correctly only if I run the macro while my active sheet is "Forecast", but then it stops after pasting that data and doesn't move onto the following two sheets. I'm also not entirely sure the existing code I have will identify the first empty row to append data to in the destination sheets.
I'm pretty new to using VBA, so a guide in the right direction would be very appreciated.
Sub CalendarAutomation()
ClearSheets
CopyInternal
CopyExternal
End Sub
Sub ClearSheets()
'Clear out Contents
Sheets("Internal Calendar").Select
activesheet.Range("C2:G250").Select
Selection.ClearContents
Sheets("External Calendar").Select
Range("C2:G250").Select
Selection.ClearContents
End Sub
Sub CopyInternal()
Dim ws As Variant
Dim starting_ws As Worksheet
Dim ending_ws As Worksheet
Dim rng As range
Set starting_ws = ThisWorkbook.Worksheets("Forecast")
Set ending_ws = ThisWorkbook.Worksheets("Internal Calendar")
Set rng = ActiveRange
For ws = 2 To 4
If Selection.AutoFilter = OFF Then Selection.AutoFilter
ws.rng.AutoFilter Field:=6, Criteria1:="=Both", _
Operator:=xlOr, Criteria2:="=Internal"
UsedRange.Copy
ending_ws.range(Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row).Paste
Next ws
End Sub
Sub CopyExternal()
Dim ws As Worksheet
Dim unusedRow As Long
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Controls" _
And Not ws.Name = "Internal Calendar" _
And Not ws.Name = "External Calendar" Then
Range("$C$3:$H$14").AutoFilter Field:=6, Criteria1:="=Both", _
Operator:=xlOr, Criteria2:="=External"
Range("C4:G14").Select
Selection.Copy
Sheets("External Calendar").Select
activesheet.Paste
unusedRow = Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
End If
Next ws
End Sub

Answer 1

Try this:
Sub tst()
Dim ctrl As Worksheet: Set ctrl = ThisWorkbook.Sheets("Controls")
Dim fcast As Worksheet: Set fcast = ThisWorkbook.Sheets("Forecast")
Dim fu As Worksheet: Set fu = ThisWorkbook.Sheets("Financial Update")
Dim bg As Worksheet: Set bg = ThisWorkbook.Sheets("Board Goals")
Dim ic As Worksheet: Set ic = ThisWorkbook.Sheets("Internal Calendar")
Dim ec As Worksheet: Set ec = ThisWorkbook.Sheets("External Calendar")
Dim ic_last_r As Long
Dim ec_last_r As Long
ic_last_r = ic.Cells(ic.Rows.Count, 3).End(xlUp).Row
ec_last_r = ec.Cells(ec.Rows.Count, 3).End(xlUp).Row
If ic_last_r < 2 Then ic_last_r = 2 'avoid deleting 1st row
If ec_last_r < 2 Then ec_last_r = 2
ic.Rows("2:" & ic_last_r).ClearContents
ec.Rows("2:" & ec_last_r).ClearContents
copy_paste fcast, ic, "Both", "Internal", Array("Controls", "Forecast", "External Calendar")
copy_paste fcast, ec, "Both", "External", Array("Controls", "Forecast", "Internal Calendar")
End Sub
Sub copy_paste(ws1 As Worksheet, ws2 As Worksheet, c1 As String, c2 As String, wsheets)
Dim ws As Worksheet
Dim ws2_last_r As Long
For Each ws In ThisWorkbook.Worksheets
For i = LBound(wsheets) To UBound(wsheets)
If ws.Name = wsheets(i) Then GoTo n_ext
Next
ws2_last_r = ws2.Cells(ws2.Rows.Count, 3).End(xlUp).Row
ws1.Range("A1").AutoFilter 8, c1, xlOr, c2
ws1.Range("A1").CurrentRegion.Columns("C:G").Copy
ws2.Range("C" & ws2_last_r).PasteSpecial xlPasteAll
ws1.Range("A1").AutoFilter
n_ext:
Next
End Sub

Answer 2

Your code after changes (I hope it will work for you but there is a space for improvement):
Sub CalendarAutomation()
ClearSheets
CopyInternal
CopyExternal
End Sub
Sub ClearSheets()
'Clear out Contents
Sheets("Internal Calendar").Range("C2:G250").ClearContents
Sheets("External Calendar").Range("C2:G250").ClearContents
End Sub
Sub CopyInternal()
Dim ws As Variant
Dim starting_ws As Worksheet
Dim ending_ws As Worksheet
Dim rng As Range
Set starting_ws = ThisWorkbook.Worksheets("Forecast")
Set ending_ws = ThisWorkbook.Worksheets("Internal Calendar")
For ws = 2 To 4
If Sheets(ws).AutoFilterMode Then Sheets(ws).Range("A1").AutoFilter
Sheets(ws).Range("A1").AutoFilter 6, "Both", xlOr, "Internal"
Sheets(ws).UsedRange.Copy
ending_ws.Cells(ending_ws.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row, 3).PasteSpecial xlPasteAll 'pasting into "C" column
Next ws
End Sub
Sub CopyExternal()
Dim ws As Worksheet
Dim unusedRow As Long
Dim external As Worksheet: Set external = ThisWorkbook.Worksheets("External Calendar")
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = "Controls" _
And Not ws.Name = "Internal Calendar" _
And Not ws.Name = "External Calendar" Then
unusedRow = external.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row 'if you want to find last filled row i suggest to change to: external.cells(external.rows.count, [column number]).end(xlup).row
ws.Range("A1").AutoFilter Field:=6, Criteria1:="=Both", _
Operator:=xlOr, Criteria2:="=External"
ws.UsedRange.Copy
external.Cells(unusedRow, 1).PasteSpecial xlPasteAll 'paste into "A" column
End If
Next ws
End Sub