Hello. Please, I'm trying to write a macro that will filter and copy from one sheet to another using loop and put the criteria as the label/heading. In the attached example the criteria field is field 1.
The code is as follows:
Sub filter2() Application.ScreenUpdating = False Dim x As Range Dim rng As Range Dim last As Long Dim sht As String Dim sht1 As String sht = "DATA Sheet" sht1 = "REPORT Sheet" last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row Set rng = Sheets(sht).Range("A1:F" & last) Sheets(sht1).Cells.Clear Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True For Each x In Range([AA2], Cells(Rows.Count, "AA").End(xlUp)) With rng .AutoFilter .AutoFilter Field:=1, Criteria1:=x.Value .SpecialCells(xlCellTypeVisible).Copy Sheets(sht1).Range("A" & Rows.Count).End(xlUp).Offset(3).PasteSpecial End With Next x Sheets(sht).AutoFilterMode = False With Application .CutCopyMode = False .ScreenUpdating = True End With ActiveSheet.Range("A1").Select End Sub
The result I have and the expected result I need help with is as attached image pasted in msword.