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(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 Field:=1, Criteria1:=x.Value
- 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
- End Sub
The result I have and the expected result I need help with is as attached image pasted in msword.