copie fichier

Sub Copie()
On Error Resume Next
Sheets(Range("A1")).Cells.Copy Sheets(Range("A1") + 5).Cells
End Sub

Sub Macro1()
Dim vm As Integer 'déclare la variable vm (Valeur Maximum)
Dim sh As Worksheet 'déclare la variable sh (SHeet)
Dim n As String 'déclare la variable n (Nom)
Dim chem As String 'déclare la variable chem (CHEMin)
 
chem = ThisWorkbook.Path & "\" 'définit la variable chem
vm = 0 'définit la variable vm
 
For Each sh In Sheets 'boucle sur tous les onglets du classeur
    'si la valeur convertie en entier de A1 est supérieure à vm, alors vm prend cette valeur
    If CInt(sh.Range("A1")) > vm Then vm = CInt(sh.Range("A1"))
Next sh 'prochain onglet de la boucle (à la fin, vm à pris la plus grande valeur)
 
'boite d'entrée pour demander le nom du fichier copié
n = InputBox("Donnez le nom au nouveau fichier. Sans l'extension !", "RENOMMER")
If n = "" Then Exit Sub 'si aucun nom n'est édité, sort de la procédure
ActiveWorkbook.SaveAs Filename:=chem & n & ".xls" 'copie le classeur avec le nom proposé
 
For Each sh In Sheets 'boucle sur tous les onglets du nouveau classeur
    'si A1 de l'onglet n'est pas vide, ajoute vm à la valeur de A1
    If sh.Range("A1") <> "" Then sh.Range("A1") = CInt(sh.Range("A1")) + vm
Next sh 'prochain onglet de la boucle
ActiveWorkbook.Save 'sauve le nouveau classeur
End Sub

'boite d'entrée pour demander le nom du fichier copié
n = InputBox("Donnez le nom au nouveau fichier. Sans l'extension !", "RENOMMER")
If n = "" Then Exit Sub 'si aucun nom n'est édité, sort de la procédure
ActiveWorkbook.SaveAs Filename:=chem & n & ".xls" 'copie le classeur avec le nom proposé

n = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
ActiveWorkbook.SaveAs Filename:=chem & n & " copie.xls" 'copie le classeur