'file B
A1: ='C:Users...Desktop[nome file.xlsx]Foglio1'!$A$1

Sub cambia_Percorso()
Dim P_Vecchio As String, P_Nuovo As String, File As String, Form As String, N As Long, Area As Range, cell As Range
Dim PrendiDati As String, Rif As String, Foglio As String
P_Nuovo = Left(ThisWorkbook.Path, Len(ThisWorkbook.Path) - 13) ' meno 13 perchè conosciamo i caratteri di Sottocartella
Set Area = Range("B2:D11")
    For Each cell In Area
        P_Vecchio = Left(cell.Formula, InStr(cell.Formula, "[") - 1)
        If P_Nuovo <> P_Vecchio Then
            Rif = Mid(cell.Formula, InStr(cell.Formula, "!") + 1, Len(cell.Formula))
            Foglio = Mid(cell.Formula, InStr(cell.Formula, "]") + 1, InStr(cell.Formula, "!") - InStr(cell.Formula, "]") - 2)
            File = Mid(cell.Formula, InStr(cell.Formula, "[") + 1, InStr(cell.Formula, "]") - InStr(cell.Formula, "[") - 1)
            cell.FormulaR1C1 = "='" & P_Nuovo & "[" & File & "]" & Foglio & "'!" & Range(Rif).Range("A1").Address(, , xlR1C1)
            'PrendiDati = ExecuteExcel4Macro("'" & P_Nuovo & "[" & File & "]" & Foglio & "'!" & Range(Rif).Range("A1").Address(, , xlR1C1))
        End If
    Next cell
Set Area = Nothing
End Sub

'formula da mettere in A1 Grazie ninai
=SINISTRA(CELLA("nomefile";A1);TROVA("@";SOSTITUISCI(CELLA("nomefile";A1);"";"@";LUNGHEZZA(CELLA("nomefile";A1))-LUNGHEZZA(SOSTITUISCI(CELLA("nomefile";A1);"";"";))-1))-1)

Sub Dati()
Dim Area As Range, cell As Range, rif As String, percorso As String, file_foglio As String
percorso = [A1].Value
file_foglio = [A2].Value
Set Area = Range("B2:D15")
    For Each cell In Area
        If cell <> "" Then
            rif = Mid(cell.Formula, InStr(cell.Formula, "!") + 1, Len(cell.Formula))
            On Error Resume Next
            cell.FormulaR1C1 = "='" & percorso & file_foglio & "'!" & Range(rif).Range("A1").Address(, , xlR1C1)
        End If
    Next cell
Set Area = Nothing
MsgBox "Fatto"
End Sub

'formula da mettere in A1 Grazie ninai
=SINISTRA(CELLA("nomefile";A1);TROVA("@";SOSTITUISCI(CELLA("nomefile";A1);"";"@";LUNGHEZZA(CELLA("nomefile";A1))-LUNGHEZZA(SOSTITUISCI(CELLA("nomefile";A1);"";""))-1)))

Option Explicit
Sub copia()
Dim sh1 As Worksheet: Set sh1 = Worksheets("Foglio1") ' Sul FILE A gli dico che il foglio1 sarà dove scrivere i dati (da adesso si chiama Sh1)
Dim Percorso As String, X As Long, Y As Long, Nome As String, C As Long, R  As Long 'valorizzo delle variabili
'Adesso dobbiamo dirgli il percorso dove aprire il secondo file se usi la formula in A1 basta scrivere
Percorso = sh1.Cells(1, 1) ' Cella A1, oppure si poteva scrivere--->Percorso = "C:Prova" 'con la  finale
Nome = "FILE B.Xls" 'non il massimo avere dei spazi nei nomi
Application.ScreenUpdating = False 'per evitare tremolio sul monitor
Workbooks.Open (Percorso & Nome)
Dim sh2 As Worksheet: Set sh2 = Worksheets("Foglio1") 'gli dico su quale foglio prendere i dati (da adesso si chiama Sh2)
R = 5 'significa che copiera dalla riga 5
C = 2 'significa che copiera in colonna 2 = B
For X = 1 To 12 'Inzia a fare una ripetiziono sino a 12 volte controlla bene forse sono 13 i cicli
    'senza spostarsi tra i due file con Sh1 e Sh2 si fa tutto
    sh1.Cells(2, C) = sh2.Cells(R, 12) 'scrive in (2, C)al primo ciclo 2 è la riga C = B,,,,,prende i dati da(R, 12) R = 5,,,,12 = L
    sh1.Cells(3, C) = sh2.Cells(R + 3, 12) 'scrive in riga 3,,,,,prende i dati dalla riga R =5+3
    sh1.Cells(4, C) = sh2.Cells(R + 4, 12) 'scrive in riga 4,,,,,prende i dati dalla riga R =5+4
    sh1.Cells(5, C) = sh2.Cells(R + 5, 12) 'scrive in riga 5,,,,,prende i dati dalla riga R =5+5
    sh1.Cells(6, C) = sh2.Cells(R + 6, 12) 'scrive in riga 6,,,,,prende i dati dalla riga R =5+6
    R = R + 21 ' se prima prendeva dalla riga 5 adesso aumentano si sposta di riga R = 26 ecc ecc
    C = C + 1 ' se prima scriveva in B adesso aumentano si sposta di colonna ecc ecc
Next X ' ricomincia il ciclo
Set sh2 = Worksheets("Foglio2") 'gli dico su quale foglio prendere i dati (da adesso si chiama Sh2)
R = 6 'significa che copiera dalla riga 6
C = 2 'significa che copiera in colonna 2 = B
For X = 1 To 12 'Inzia a fare una ripetiziono sino a 12 volte controlla bene forse sono 13 i cicli
    'senza spostarsi tra i due file con Sh1 e Sh2 si fa tutto
    sh1.Cells(7, C) = sh2.Cells(R, 7) 'scrive in (7, C)al primo ciclo 7 è la riga C = B,,,,,prende i dati da(R, 7) R = 6,,,,7 = G
    sh1.Cells(8, C) = sh2.Cells(R + 3, 7) 'scrive in riga 8,,,,,prende i dati dalla riga R =6+3
    sh1.Cells(9, C) = sh2.Cells(R + 4, 7) 'scrive in riga 9,,,,,prende i dati dalla riga R =6+4
    sh1.Cells(10, C) = sh2.Cells(R + 5, 7) 'scrive in riga 10,,,,,prende i dati dalla riga R =6+5
    sh1.Cells(11, C) = sh2.Cells(R + 6, 7) 'scrive in riga 11,,,,,prende i dati dalla riga R =6+6
    R = R + 15 ' se prima prendeva dalla riga 6 adesso aumentano si sposta di riga R = 21 ecc ecc
    C = C + 1 ' se prima scriveva in B adesso aumentano si sposta di colonna ecc ecc
Next X ' ricomincia il ciclo
ActiveWorkbook.Close False ' chiudo il file dove ho prelevato i dati senza salvare
MsgBox "Fatto" 'Per avvisare che è finito
Application.ScreenUpdating = True 'riaccendo il tremolio monitor
Set sh1 = Nothing 'distruggo il set
Set sh2 = Nothing 'distruggo il set
End Sub