Hello Team and thank you for all you do. I have searched many threads here to find an answer to most likely a simple issue that I have overlooked.
I am running the code below which works just fine except for 1 issue. When I run the code it does not copy over the first 3 rows of Header Data that I need in the new worksheets it creates. Surely I am missing something ? Perhaps another offset?
Can someone please open my eyes to what I am missing?
Romefucan
Sub Macro2()
Dim WS As Worksheet, R As Range
Application.ScreenUpdating = False
With Sheets("Test")
.Range("A1").AutoFilter field:=4, Criteria1:=">1"
For Each R In .Columns(4).SpecialCells(xlCellTypeVisible).Areas
If R(1).Row > 1 Then
Set WS = Worksheets.Add(After:=Worksheets(Worksheets.Count))
R.Offset(, -3).Resize(, 250).Copy WS.Range("A1")
WS.Name = Replace(R(1).Offset(, -2), ":", ",")
End If
Next R
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
I am running the code below which works just fine except for 1 issue. When I run the code it does not copy over the first 3 rows of Header Data that I need in the new worksheets it creates. Surely I am missing something ? Perhaps another offset?
Can someone please open my eyes to what I am missing?
Romefucan
Sub Macro2()
Dim WS As Worksheet, R As Range
Application.ScreenUpdating = False
With Sheets("Test")
.Range("A1").AutoFilter field:=4, Criteria1:=">1"
For Each R In .Columns(4).SpecialCells(xlCellTypeVisible).Areas
If R(1).Row > 1 Then
Set WS = Worksheets.Add(After:=Worksheets(Worksheets.Count))
R.Offset(, -3).Resize(, 250).Copy WS.Range("A1")
WS.Name = Replace(R(1).Offset(, -2), ":", ",")
End If
Next R
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
