excelvbafiltercopypaste

VBA code is not copying the full set of data


The below code is supposed to copy all matching REGION rows with e.g. ASIA (EX. NEAR EAST), but for some reason it doesn't do anything if the first row (non-header) is not "ASIA (EX. NEAR EAST)".

enter image description here

Sub copy_data()

Dim count_col As Integer
Dim count_row As Integer
Dim og As Worksheet
Dim wb As Workbook
Dim region As String

Set og = Sheet1
region = og.Cells(1, 1).Text

Set wb = Workbooks.Add
wb.Sheets("Sheet1").Name = region

og.Activate
count_col = WorksheetFunction.CountA(Range("A4", Range("A4").End(xlToRight)))
count_row = WorksheetFunction.CountA(Range("A4", Range("A4").End(xlDown)))

ActiveSheet.Range("A4").AutoFilter Field:=2, Criteria1:=region

og.Range(Cells(4, 1), Cells(count_row, count_col)). _
SpecialCells(xlCellTypeVisible).Copy
wb.Sheets(region).Cells(1, 1).PasteSpecial xlPasteValues

Application.CutCopyMode = False
og.ShowAllData
og.AutoFilterMode = False

End Sub

If the first row contains ASIA (EX. NEAR EAST), it stops at the second row etc.


Solution

  • og.Range(Cells(4, 1), Cells(count_row, count_col))
    

    How to avoid using Select in Excel VBA

    Microsoft documentation:

    Range.Resize property (Excel)

    Sub copy_data()
        
        Dim count_col As Long
        Dim count_row As Long
        Dim og As Worksheet
        Dim wb As Workbook, sht As Worksheet
        Dim region As String
        Const START_CELL = "A4"
        Set og = Sheet1
        region = og.Cells(1, 1).Text
        
        Set wb = Workbooks.Add
        Set sht = ActiveSheet
        sht.Name = region
        
        With og.Range(START_CELL)
            count_col = .End(xlToRight).Column
            count_row = og.Cells(og.Rows.Count, 1).End(xlUp).Row - .Row + 1
            .AutoFilter Field:=2, Criteria1:=region
            .Resize(count_row, count_col).SpecialCells(xlCellTypeVisible).Copy
        End With
        sht.Cells(1, 1).PasteSpecial xlPasteValues
        
        Application.CutCopyMode = False
        og.ShowAllData
        og.AutoFilterMode = False
        
    End Sub
    

    Microsoft documentation:

    Range.CurrentRegion property (Excel)

        With og.Range(START_CELL)
            .AutoFilter Field:=2, Criteria1:=region
            .CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
        End With