0

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:

  1. Controls
  2. Forecast
  3. Financial Update
  4. Board Goals
  5. Internal Calendar
  6. 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:

  1. First delete any existing information in "Internal Calendar" sheet and "External Calendar" sheet from Row 2 down without deleting the headers.
  2. 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.
  3. Repeat step 2 except Filter H on "Both" and "External" and Copy/Paste the filtered info into "External Calendar" starting in column C.
  4. 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
Pato
  • 9
  • 3
  • 3
    It would be helpful to give [this question](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) a thorough read. – BigBen Sep 19 '19 at 16:47

2 Answers2

0

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
mattJ
  • 51
  • 3
  • That didn't quite work. I'm not sure why, but it only filtered and copied/pasted the filtered data from the Forecast worksheet. It didn't append the filtered and copied/pasted data from Financial Update and Board Goals below. I pasted some reworked code in my original post, not sure if what I have is workable or if I just need to completely scrap it. – Pato Sep 19 '19 at 19:36
  • Well...I don't know why. It works for me. But if you want to exclude a worksheet you should add it to array. If you want to include it - remove from array. – mattJ Sep 20 '19 at 18:07
0

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
mattJ
  • 51
  • 3