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 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
| Sub centredecout()
Dim WBSource As Workbook, WBDest As Workbook
Dim file_exist As String
Dim path As String, file As String, check_cell As String, new_file As String
Dim j As Long, i As Long, k As Long, last_row As Long, empty_last_row As Long
file = ActiveWorkbook.Name 'nom du fichier en cours : testmacro ici
last_row = Worksheets(1).Range("A65536").End(xlUp).Row 'dernière ligne du fichier en cours
Set WBSource = Workbooks(file) 'workbook source pour le c/c de ligne
path = "C:\Documents and Settings\lcristante\Desktop\test\" 'chemin du dossier global
Set WBSource = Workbooks(file)
Application.ScreenUpdating = False
For j = 5 To last_row 'balayage des centre de coût
check_cell = WBSource.Sheets("Feuil1").Range("AM" & j).Value 'selection de la cellule colonne AM et ligne j
file_exist = Dir(path & check_cell & ".xls")
Application.DisplayAlerts = False
If file_exist = "" Then 'si le fichier n'existe pas, on en créé un nouveau
new_file = path & check_cell
Dim XLBook As Workbook
Dim XLSheet As Worksheet
Set XLBook = Workbooks.Add
XLBook.SaveAs new_file
SetAttr new_file & ".xls", vbNormal
Set WBDest = Workbooks.Open(new_file)
'on met en place le fichier de destination
SetAttr new_file & ".xls", vbNormal
WBSource.Worksheets(1).Rows(3).Copy _
Destination:=WBDest.Worksheets(1).Cells(1, 1) 'c/c de l'entête du tableau
empty_last_row = WBDest.Worksheets(1).Range("A65536").End(xlUp).Row + 1 'on selectionne la dernière ligne vide
WBSource.Worksheets(1).Rows(4).Copy _
Destination:=WBDest.Worksheets(1).Cells(empty_last_row, 1)
empty_last_row = WBDest.Worksheets(1).Range("A65536").End(xlUp).Row + 1 'on selectionne la dernière ligne vide
WBSource.Worksheets(1).Rows(j).Copy _
Destination:=WBDest.Worksheets(1).Cells(empty_last_row, 1) 'c/c de la ligne
WBDest.Save
WBDest.Close 'on le ferme
Else
file = path & check_cell & ".xls"
SetAttr file, vbNormal
Set WBDest = Workbooks.Open(file) 'on met en place le fichier de destination
empty_last_row = WBDest.Worksheets(1).Range("A65536").End(xlUp).Row + 1 'on selectionne la dernière ligne vide
WBSource.Worksheets(1).Rows(j).Copy _
Destination:=WBDest.Worksheets(1).Cells(empty_last_row, 1) 'c/c
WBDest.Save
WBDest.Close 'on le ferme
End If
Application.DisplayAlerts = True
Next j
Application.ScreenUpdating = True
End Sub |
Partager