Help to improve my code to filter data

[gabrielkfc]

Hi, im using the code below to filter a large list of data and put on specific ranges on another sheet, the whole code is too large and i would like to make it simpler, this is one of its parts that repeats for different data:

With Worksheets("Plan 1")
If WorksheetFunction.CountIf(.Columns(8), "") <> 0 Then
.AutoFilterMode = False
.Range("G1:G100").AutoFilter
.Range("G1:G100").AutoFilter Field:=1, Criteria1:=">0", _
VisibleDropDown:=False, Operator:=xlAnd, Criteria2:="<=0.99"
End If
End With

Call CopyFilter

Sub CopyFilter()
Dim rng As Range
Dim rng2 As Range
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(0, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Plan 2").Range("F4")

rng.Offset(1, 1).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Plan 2").Range("G4")

rng.Offset(1, -1).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Plan 2").Range("E4")

rng.Offset(1, -2).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Plan 2").Range("D4")

rng.Offset(1, -3).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Plan 2").Range("C4")

rng.Offset(1, -4).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Plan 2").Range("B4")

rng.Offset(1, -6).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Plan 2").Range("A4")

End If
ActiveSheet.ShowAllData

End Sub

Thanks for your help!