مساعدة فى تعديل كود ترحيل

[kadry amin]

Sub Autofilter_Copy_Visible_Cells()
    Dim Cel As Range

    Application.ScreenUpdating = False
        With ActiveSheet
            .Range("G3:J5000").ClearContents
    
            For Each Cel In .Range("G3:l3")
                .AutoFilterMode = False
                .Range("A1:C1").AutoFilter Field:=3, Criteria1:=Cel.Value
                .Range("B3:B" & .Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
    
                .Cells(6, Cel.Column).PasteSpecial xlPasteValues
            Next Cel
            
            .AutoFilterMode = False
            Application.Goto .Range("A1")
        End With
        
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
ارجو المساعدة فى تعديل هذا الكود لزيادة عدد الاعمدة المرحل منها والاعمدة المرجل اليها