I'm new to VBA and I have been trying to get my macro to run through a list of names in an array and create a new WS based on that name. Then have my macro to run through a list of group numbers and see if they can be found in a worksheet column. If they are found, I need the main worksheet, "DataSource" to be filtered by the group numbers and paste the filtered data into the newly created worksheets. I apologize if this is not well explained. So far I have been able to create the new worksheets but when I try to filter through the second array of group numbers I get the error "Type Mismatch"(reference ln 41). I'm also struggling with how to paste the filtered data into their designated worksheets without having to declare a variable name for each WS. Please help!

Sub Loops()

'Declare Variant Array for Sheet Names
Dim WSNames(1 To 3) As String
WSNames(1) = "NA"
WSNames(2) = "EU"
WSNames(3) = "APAC"

'Declare Variant to Hold Array Elements
Dim item As Variant

'Loop through entire array

For Each item In WSNames
'create a new worksheet using the sheet names in array
    Sheets.Add(After:=Sheets("DataSource")).Name = item
Next item

'Set Variables for Data WS
Dim DataWS As Worksheet
Dim GrpRge As Range
Dim DataRge As Range

Set DataWS = Worksheets("DataSource")
Set GrpRge = DataWS.Range("G2").EntireColumn


'Declare Variant Array for Group Numbers

Dim GrpNumbers(1 To 3) As Integer
GrpNumbers(1) = Array(18522, 20667)
GrpNumbers(2) = 18509
GrpNumbers(3)= 56788


'Declare Integer to Hold Array Elements
Dim i As Variant

'Filter Data Worksheets to Create Pivot Tables
For Each i In CCNumbers
    If i = GrpRge.Value Then Worksheets("DataSource").Range("G2").AutoFilter Field:=7, Criteria1:=i
    Set DataRge = Worksheets("DataSource").Range("As").CurrentRegion
    Worksheets("DataSource").Activate
    DataRge.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    WSNames.Range("A1").PasteSpecial Paste:=xlPasteAll
        Next i

End Sub

Tried Creating a For Loop but it won't run correctly.

CodePudding user response：

Export Groups of Data

Before

After

The Code

Option Explicit

Sub ExportGroups()

    ' Populate a String array with the worksheet names.
    Dim wsNames(1 To 3) As String
    wsNames(1) = "NA"
    wsNames(2) = "EU"
    wsNames(3) = "APAC"

    ' Populate a Variant array with the group numbers.
    Dim grpNumbers(1 To 3) As Variant
    grpNumbers(1) = Array("18522", "20667") ' use strings here!!!
    grpNumbers(2) = 18509
    grpNumbers(3) = 56788
    
    ' Turn off settings.
    Application.ScreenUpdating = False
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' Ensure the workbook is active because cells are being selected
    ' later in the code (e.g. 'dfCell.Select').
    If Not wb Is ActiveWorkbook Then wb.Activate
    
    ' Reference the Source worksheet, the one read (copied) from.
    Dim sws As Worksheet: Set sws = wb.Worksheets("DataSource")
    ' Clear active filters, if any.
    If sws.FilterMode Then sws.ShowAllData
    ' Reference the Source range.
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
    
    ' Declare additional variables.
    Dim dws As Worksheet ' Destination Worksheet (the one written (pasted) to)
    Dim dfCell As Range
    Dim n As Long ' Counter (For...Next Control Variable)

    ' Loop through the elements of the arrays.
    For n = UBound(wsNames) To LBound(wsNames) Step -1
    ' or:
    'For n = UBound(grpNumbers) To LBound(grpNumbers) Step -1
        ' Add a new worksheet (after the source worksheet)...
        Set dws = wb.Worksheets.Add(After:=sws)
        ' ... and rename it using the current name from the names array.
        dws.Name = wsNames(n)
        If IsArray(grpNumbers(n)) Then ' multiple group numbers (in an array)
            srg.AutoFilter 7, grpNumbers(n), xlFilterValues
        Else ' a single group number
            srg.AutoFilter 7, grpNumbers(n) ', 'xlAnd' is default (irrelevant)
        End If
        ' Reference the first destination cell.
        Set dfCell = dws.Range("A1")
        ' Copy column widths using the source's header row.
        srg.Rows(1).Copy
        dfCell.PasteSpecial xlPasteColumnWidths
        ' Select the first cell since now the selection is the first row,
        ' a by-product of 'PasteSpecial'.
        dfCell.Select
        ' Copy the visible range.
        srg.SpecialCells(xlCellTypeVisible).Copy dfCell
        ' Clear the filter.
        sws.ShowAllData
    Next n
    
    ' Turn off AutoFilter (out-comment to keep the auto filter arrows).
    sws.AutoFilterMode = False
    
    ' Select the first source cell.
    Application.Goto srg.Cells(1) ' includes activating the worksheet

    ' Turn on settings.
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "Data groups exported.", vbInformation

End Sub