Wednesday, March 9, 2016

Copy visible data from filtered range of all sheets to summary sheet, matching heading



Query: I have sales data in various sheets (about 100 plus columns & a million rows of data in it) also   data is filtered in it. 

I wanted to copy these filtered data to summary sheet, but only a few columns (I have all those columns heading in summary sheet) 


Solution through macro:

Option Explicit 
Sub Macro1() 
    Dim Rng As Range, c As Range 
    Dim sCell As Range 
    Dim rSize As Long 
    Dim dest As Range 
    Dim lDestRow As Long 
    Dim i As Integer 
     
    Sheets("Base Sheet").Select 
    i = 0 
    Set Rng = Range([D1], [D1].End(xlToRight)) 
    For Each c In Rng 
        Set sCell = Sheets("Roster").Range("1:1").Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlWhole) 
        rSize = Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Cells.Count 
        If c.Offset(1, 0).Value <> "" Then 
            Set dest = c.End(xlDown).Offset(1, 0) 
            If i = 0 Then 
                lDestRow = dest.Row 
            End If 
             
            If dest.Row < lDestRow Then 
                Set dest = Cells(lDestRow, dest.Column) 
            End If 
             
            Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy 
            dest.Select 
            ActiveSheet.Paste 
        Else 
            Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Copy 
            Set dest = c.Offset(1, 0) 
             
            If dest.Row < lDestRow Then 
                Set dest = Cells(lDestRow, dest.Column) 
            End If 
             
            dest.Select 
            ActiveSheet.Paste 
        End If 
        i = i + 1 
    Next 
End Sub
Cheers!!