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:
Code
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 SubThe result I have and the expected result I need help with is as attached image pasted in msword.
Thank you
Okogbe Nathaniel