1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
|
Option Explicit
Sub test()
Dim w As Worksheet, Ch1$, Ch2$, i&, j%
'chemin vers le doossier client à adapter
Ch1 = "C:\Documents and Settings\Clients\"
'nom complet classeur matrice à adapter
Ch2 = "C:\Documents and Settings\Matrice prévisions clients internet.xls"
'déclaration feuille données client
Set w = Worksheets("Feuil1")
'pour chaque ligne de la feuille données client
For i = 2 To w.Cells(Rows.Count, 1).End(xlUp).Row
'si le classeur portant le nom du client n'existe pas à l'endroit spécifié
If Dir(Ch1 & w.Cells(i, 1) & ".xlsm") <> "" = False Then
Workbooks.Open Ch2 'ouvrir le classeur matrice
'remplir les informations dans le classeur matrice
Cells(2, 2) = w.Cells(i, 1)
Cells(3, 2) = w.Cells(i, 3)
Cells(5, 2) = w.Cells(i, 24)
Cells(6, 3) = w.Cells(i, 7)
'sauvegarder le classeur matrice sous le nom du client
ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xlsm", FileFormat:=52
'pour xls ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xls", FileFormat:=56
'pour xlsx : ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xlsx", FileFormat:=51
'fermer le classeur créé
ActiveWorkbook.Close
End If
Next i
End Sub |
Partager