VBA macro to copy and paste visible cells only

[Siddhu11011]

I have data from column A to BE and filter is already applied. I have tried below codes but due to hidden cells output is not perfect. I need a top 76 rows (header included).

Range ("A1:BF76").select
Selection. Specialcells(xlcelltypevisible).slect
OR
Activesheet.Range("A1:BF76").Specialcells(xlcelltypevisible).copy

Above codes do not give me 76 rows due to hidden rows.
Can you please help me out

 

[Domenic]

Activesheet.Range("A1:BF76").Specialcells(xlcelltypevisible).copy

The above line of code copies the filtered/visible rows in A1:BF76, including the header. If this is not what you want, please clarify.

 

[Siddhu11011]

Activesheet.Range("A1:BF76").Specialcells(xlcelltypevisible).copy

The above line of code copies the filtered/visible rows in A1:BF76, including the header. If this is not what you want, please clarify.

Thanks for your response ....
No, I don't want that because I need to copy initial 76 rows from the filtered data Ex. From 1st row(header) to 76th row post applying filter.
Note: There will be hidden rows due to applied filter

 

[Domenic]

Oh I see, you want to copy the first 76 rows from data that has been filtered, which includes the header row. In that case, assuming that the workbook running the code contains your data, try...

Option Explicit

Sub Copy_First_N_Filtered_Rows()

    Const FIRST_N_FILTERED_ROWS As Long = 76

    With ThisWorkbook.Worksheets("Sheet1") 'change the sheet name accordingly
   
        If Not .FilterMode Then
            MsgBox "No filter applied!", vbExclamation
            Exit Sub
        End If
       
        With .AutoFilter.Range
       
            On Error Resume Next
            Dim FilteredRows As Range
            Set FilteredRows = .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            If FilteredRows Is Nothing Then
                MsgBox "No records found!", vbExclamation
                Exit Sub
            End If
            On Error GoTo 0
           
            Dim firstNFilteredRows As Range
            Dim filteredArea As Range
            Dim filteredRow As Range
            Dim rowCount As Long
            rowCount = 0
            For Each filteredArea In .SpecialCells(xlCellTypeVisible).Areas
                For Each filteredRow In filteredArea.Rows
                    If firstNFilteredRows Is Nothing Then
                        Set firstNFilteredRows = filteredRow
                    Else
                        Set firstNFilteredRows = Union(firstNFilteredRows, filteredRow)
                    End If
                    rowCount = rowCount + 1
                    If rowCount >= FIRST_N_FILTERED_ROWS Then Exit For
                Next filteredRow
                If rowCount >= FIRST_N_FILTERED_ROWS Then Exit For
            Next filteredArea
           
            firstNFilteredRows.Copy
       
        End With
       
    End With
   
End Sub

I'm going to be logging off now, so if there are any issues I'll address them sometime later.

Hope this helps!

 

[Siddhu11011]

Oh I see, you want to copy the first 76 rows from data that has been filtered, which includes the header row. In that case, assuming that the workbook running the code contains your data, try...

Option Explicit

Sub Copy_First_N_Filtered_Rows()

    Const FIRST_N_FILTERED_ROWS As Long = 76

    With ThisWorkbook.Worksheets("Sheet1") 'change the sheet name accordingly
  
        If Not .FilterMode Then
            MsgBox "No filter applied!", vbExclamation
            Exit Sub
        End If
      
        With .AutoFilter.Range
      
            On Error Resume Next
            Dim FilteredRows As Range
            Set FilteredRows = .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            If FilteredRows Is Nothing Then
                MsgBox "No records found!", vbExclamation
                Exit Sub
            End If
            On Error GoTo 0
          
            Dim firstNFilteredRows As Range
            Dim filteredArea As Range
            Dim filteredRow As Range
            Dim rowCount As Long
            rowCount = 0
            For Each filteredArea In .SpecialCells(xlCellTypeVisible).Areas
                For Each filteredRow In filteredArea.Rows
                    If firstNFilteredRows Is Nothing Then
                        Set firstNFilteredRows = filteredRow
                    Else
                        Set firstNFilteredRows = Union(firstNFilteredRows, filteredRow)
                    End If
                    rowCount = rowCount + 1
                    If rowCount >= FIRST_N_FILTERED_ROWS Then Exit For
                Next filteredRow
                If rowCount >= FIRST_N_FILTERED_ROWS Then Exit For
            Next filteredArea
          
            firstNFilteredRows.Copy
      
        End With
      
    End With
  
End Sub

I'm going to be logging off now, so if there are any issues I'll address them sometime later.

Hope this helps!

Thanks for your prompt response
Above code is working partially. If I copy above code and paste 2 times-at different places in my existing macro then it gives me an error.
Ex. I`m applying filter condition then I pate your code, again I have applied filter condition then just to copy the filtered data I`m pasting above code again and it`s giving me an error.
Your macro is running perfectly for the 1st filtered condition but showing an error massage in 2nd filtered condition. Any thoughts on this?

 

[Alex Blakenburg]

Instead of copying in the code, copy the whole code in as its own Sub and in the 2 places you want to use it just put:

Call Copy_First_N_Filtered_Rows

 

[Siddhu11011]

Instead of copying in the code, copy the whole code in as its own Sub and in the 2 places you want to use it just put:

Call Copy_First_N_Filtered_Rows

Thank you so much and pardon me for my limited knowledge in Macro. It worked and appropriate for your time!

 

[Alex Blakenburg]

No problem. Glad Domenic’s solution is working for you now.