Copier coler valeur d'un classeur à un autre

Sub CopierX1X2()

    Dim varCheminS As String, varCheminD As String
    Dim PWD As String, Pole As String
    Dim deb As String, lotcft As String
    Dim varAdresse As String, varValeur As Variant
    Dim Plage As Range, Cellule As Range
    
    Application.ScreenUpdating = False
    varCheminS = "D:\Documents and Settings\Hudson Hawks\Mes documents\source.xls"
    Workbooks.Open varCheminS, 0, ReadOnly:=False
    lotcft = ActiveWorkbook.Name
    Pole = ActiveSheet.Range("AA3").Value
    varCheminD = "D:\Documents and Settings\Hudson Hawks\Mes documents\destination.xls"
    Workbooks.Open varCheminD, 0, ReadOnly:=False
    deb = ActiveWorkbook.Name
    Sheets(1).Select
    Sheets.Add
    On Error Resume Next
    ActiveSheet.Name = Pole
    
    Workbooks(lotcft).Activate
    Set Plage = ActiveSheet.UsedRange
        
    For Each Cellule In Plage
        varAdresse = ""
        varValeur = ""
        If (Mid(Cellule.Value, 1, 1) <> "=") Then
            varAdresse = Cellule.Address
            varValeur = Cellule.Value
            If (varValeur <> "") Then
                Workbooks(deb).Activate
                ActiveSheet.Range(varAdresse).Value = varValeur
                Workbooks(lotcft).Activate
            End If
        End If
    Next Cellule
    
    Workbooks(deb).Activate
    ActiveSheet.Unprotect PWD
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Workbooks(lotcft).Activate
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub
'

Sub CopieDansAutreClasseur()
Dim VarChemin As String, NomOrigine As String
Dim NomCopie As String, CheminCopie As String
Dim W1 As Workbook
    Set W1 = ActiveWorkbook
    CheminCopie = "C:\Users\jean\Desktop\luc\"
    NomCopie = "deb.xls"
    Workbooks.Open CheminCopie & NomCopie
    Sheets(1).Select
    Sheets.Add
    Range("A1").Select
    W1.Sheets("maquette").UsedRange.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Set W1 = Nothing
End Sub

Sub CopieDansAutreClasseur()

Dim VarChemin As String, NomOrigine As String
Dim NomCopie As String, CheminCopie As String
Dim W1 As Workbook
    
    Set W1 = ActiveWorkbook
    CheminCopie = "C:\Users\jean\Desktop\luc\"
    NomCopie = "deb.xls"
    Workbooks.Open CheminCopie & NomCopie
    Pole = ActiveSheet.Range("AA3").Value
    Workbooks(lotcft).Sheets("maquette").Copy Before:=Workbooks(deb).Sheets(1)
    ActiveSheet.Name = Pole
    Range("A1").Select
    Cells.Clear
    W1.Sheets("maquette").UsedRange.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Set W1 = Nothing

End Sub

Sub CopieDansAutreClasseur()

Dim VarChemin As String, NomOrigine As String
Dim NomCopie As String, CheminCopie As String
Dim W1 As Workbook
    
    Set W1 = ActiveWorkbook
    CheminCopie = "C:\Users\jean\Desktop\luc\"
    NomCopie = "deb.xls"
    Workbooks.Open CheminCopie & NomCopie
'Cette ligne n'est pas bonne, tu prend le nom dans le classeur qui vient d'être ouvert et d'après ce que je
'comprend le nom est dans le classeur d'origine.
'Et il n'est pas nécessaire de passer par une variable qui n'est utilisée qu'une seule fois, d'ou, 2 assignations pour un seul résultat.
    'Pole = ActiveSheet.Range("AA3").Value
' ici tu copie la feuille avec les formules, pas nécessaires vu que ce serra copier plus bas. 
    'Workbooks(lotcft).Sheets("maquette").Copy   .. Before:=Workbooks(deb).Sheets(1)
'Comme dit, 2 fois l'assignation
    'ActiveSheet.Name = Pole
'Remplacer par 
    ActiveSheet.Name  = W1.ActiveSheet.Range("AA3"). 'ça j'avais oublié.
    Range("A1").Select
    'Cells.Clear ' commande inutile dans mon poste précédant puisque la feuille est vide.
    W1.Sheets("maquette").UsedRange.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Set W1 = Nothing

End Sub

Sub CopieDansAutreClasseur()
Dim VarChemin As String, NomOrigine As String
Dim NomCopie As String, CheminCopie As String, D As String
Dim W1 As Workbook
    Set W1 = ActiveWorkbook
    CheminCopie = "C:\Users\jean\Desktop\luc\"
    D = Range("A1") ' a adapter
'Tester si le nom est bien valable, pas obligatoire mais ça vaux mieux.
    If D = "" Then
        Exit Sub
        'Eventuellement mettre un message
    ElseIf Val(Left(D, 2)) < 1 Or Val(Left(D, 2)) > 12 Then
        Exit Sub
        'Eventuellement mettre un message
    ElseIf Right(D, 2) Is Not IsNumeric Then
        Exit Sub
        'Eventuellement mettre un message
    End If
    NomCopie = "deb" & D & ".xls"
    On Error GoTo PasFichier
    Workbooks.Open CheminCopie & NomCopie
    On Error GoTo 0
    Sheets(1).Select
    Sheets.Add
    Range("A1").Select
    W1.Sheets("maquette").UsedRange.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Set W1 = Nothing
Sortie:
Exit Sub
PasFichier:
    MsgBox "le fichier " & NomCopie & " est introuvable ou a été déplacer", , "Ouvrir fichier"
    Resume Sortie
End Sub

......
    Range("A1").Select
    Set W1 = Nothing
    SousTotaux
End Sub

Sub SousTotaux()
Dim ST(1 To 3) As Double
Dim Tot(1 To 3) As Double
Dim i As Integer, e As Integer
Dim A
Dim Comp As String
    A = Array(0, 1, 3, 11)
    With Sheets("SubTot") 'adapter au nom de la feuille
        Comp = Cells(2, 10)
        For i = 2 To Range("J65536").End(xlUp).Row + 1
            If Comp = Cells(i, 10) Then
                For e = 1 To 3: ST(e) = ST(e) + Cells(i, A(e)): Next e
            Else
                For e = 1 To 3
                    Cells(i - 1, e + 24) = ST(e)
                    Tot(e) = Tot(e) + ST(e): ST(e) = Cells(i, A(e))
                Next e
                Comp = Cells(i, 10)
            End If
        Next i
        For e = 1 To 3
            Cells(i, e + 24) = Tot(e):
        Next e
    End With
End Sub

    With Sheets("deb") 

    With ActiveSheet

With Workbooks(NomCopie ).sheet(1)

Sub SousTotaux()
Dim ST(1 To 3) As Double
Dim Tot(1 To 3) As Double
Dim i As Integer, e As Integer
Dim A
Dim Comp As String
    A = Array(0, 1, 3, 12)
    With Sheets("deb") 'adapter au nom de la feuille
        Comp = Cells(2, 11)
        i = 2
        While Cells(i, 11) <> ""
            If Comp = Cells(i, 11) Then
                For e = 1 To 3: ST(e) = ST(e) + Cells(i, A(e)): Next e
            Else
                For e = 1 To 3
                    Cells(i - 1, e + 25) = ST(e)
                    Tot(e) = Tot(e) + ST(e): ST(e) = Val(Cells(i, A(e)))
                Next e
                Comp = Cells(i, 11)
            End If
            i = i + 1
            DoEvents
        Wend
        For e = 1 To 3
            Cells(i + 1, e + 25) = Tot(e):
        Next e
    End With
End Sub