aşağıdaki kodu dener misiniz?
önce sütunları -sütun başlıklarının olduğu 2. satırdaki hücreleri -seçip sonrada düğmeye basmalısınız

Dim Secili As Range

Dim xSht As Sheets

Dim TxtAdrs() As String

Set Secili = Selection

Dim Hucr As Range

Dim SeciliRng As String



xScreenUpdate = Application.ScreenUpdating

xAlert = Application.DisplayAlerts

Application.ScreenUpdating = False

Application.DisplayAlerts = False



Sheets.Add.Name = "GccSil"



SonHcr = Sheets("VERİ").Cells(Rows.Count, 1).End(xlUp).Row

For Each Hucr In Secili.Cells

    With Hucr

    TxtAdrs = Split(.Address, "$")

        SeciliRng = SeciliRng & "," & TxtAdrs(1) & TxtAdrs(2) & ":" & TxtAdrs(1) & SonHcr

    End With

Next Hucr

SeciliRng = Mid(SeciliRng, 2)



Sheets("VERİ").Range(SeciliRng).Copy Sheets("GccSil").Range("A1")

Sheets("GccSil").PrintOut

Sheets("GccSil").Delete



Application.ScreenUpdating = xScreenUpdate

Application.DisplayAlerts = xAlert