Copiare colonne non contigue tra 2 files

  
Public Sub cercacopia()      
   Dim wk1 As Workbook 'dichiaro le variabili     
   Dim wk2 As Workbook     
   Dim sh1 As Worksheet     
   Dim sh2 As Worksheet     
   Dim strFile As String, strPath As String  
On Error GoTo RigaErrore 'gestione errori
       Application.ScreenUpdating = False          
       Set wk1 = ThisWorkbook 'metto i riferimenti ai files
       cartellainiziale = "C:\Users\Microsoft\Desktop\Imballi"
       With Application.FileDialog(msoFileDialogOpen) 
       .InitialFileName = cartellainiziale     
       .Title = "Seleziona cartella e File"     
       .AllowMultiSelect = False     
       .Show         
            If .SelectedItems.Count = 0 Then Exit Sub         
            strFile = .SelectedItems(1)     
       End With     
       Set wk2 = Workbooks.Open(strFile)     
       Set sh1 = wk1.Worksheets("Appoggio") 'metto i riferimenti ai fogli    
       Set sh2 = wk2.Worksheets("WGT21SFL")           

        With sh2         
        sh1.Range("A2:E70").ClearContents         
        .Range("A2:Y70").Copy 'copio i dati da un file all'altro 
        sh1.Range("A2").PasteSpecial xlPasteValues     
        End With
   
         Application.CutCopyMode = False
         Application.DisplayAlerts = False 'inibisco avviso  salvataggio del file sorgente     
        wk2.Close 'chiudo il file sorgente  
       Application.DisplayAlerts = True     
       Application.ScreenUpdating = True  'riga sempre eseguita RigaChiusura:     
    'Set a Nothing delle variabili oggetto     
       Set sh2 = Nothing     
       Set sh1 = Nothing     
       Set wk1 = Nothing     
       Set wk2 = Nothing     
       Exit Sub  
       'in caso di errore 
  RigaErrore:     
MsgBox Err.Number & vbNewLine & Err.Description     
Resume RigaChiusura       
End Sub

.Range("A2:Y70").Copy

 With sh2
      sh1.Range("A2:E70").ClearContents  
     .Range("A2:Y70").Copy 'copio i dati da un file all'altro 

Sub Copia()
Dim r As Long, c As Long, Ur As Long, x As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Risp, Wkb As Workbook, strFile, ind As String, rng

ind = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Set Sh1 = Worksheets("Appoggio")
Sh1.Activate

If Sh1.Cells(2, 1) = "" Then Ur = 2 Else Ur = Cells(Rows.Count, 1).End(xlUp).Row
Risp = MsgBox("Attenzione! elimino i dati presenti?", vbYesNo, "Pulizia dati")
If Risp = 6 Then Sh1.Range("A2:E" & Ur).ClearContents: r = Ur Else r = Ur + 1
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = cartellainiziale
    .Title = "Seleziona cartella e File"
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
    strFile = .SelectedItems(1) 'seleziono il file
End With
Application.DisplayAlerts = False
Workbooks.Open Filename:=strFile
Set Sh2 = Worksheets(1) 'seleziono il primo foglio
Ur = Sh2.Cells(Rows.Count, 4).End(xlUp).Row
rng = Sh2.Range("A2:Y" & Ur)
ActiveWorkbook.Close
Application.DisplayAlerts = True
For x = 1 To UBound(rng)
    Sh1.Cells(r, 1) = rng(x, 4)
    Sh1.Cells(r, 2) = rng(x, 7)
    Sh1.Cells(r, 3) = rng(x, 8)
    Sh1.Cells(r, 4) = rng(x, 11)
    Sh1.Cells(r, 5) = rng(x, 25)
    r = r + 1
Next x
Sh1.Cells(1, 1).Select
Application.ScreenUpdating = True
Set Sh1 = Nothing
Set Sh2 = Nothing

End Sub