copier des données de fichiers excel d'un repertoire X vers un autre fichier

[berni027]

Voila, je confronté à une difficulté, je désir copier à l'aide d'une macro les données de plusieurs fichiers excel contenu dans un répertoire vers un autre fichier. les fichier sources sont des rapports journalier d'activité d'un site. Dans ces fichiers seulement la première feuille est contient les informations. Ces info sont regroupées en plusieurs catégorie sur la feuille ( Cat1: données1, donnée 2, donnée3.....; cat2: donnée1, donnée2, donnée3; cat3: donnée1, donnée2, donnée3). le job consiste copier ces données vers un autre classeur où chaque catégorie est une feuille a part. Dans chaque page du classeur destinataire les données se stockent en dessous des précédentes selon la date du rapport.

voici ci-dessous le code que j'ai pu fabriquer grâce au exemple trouvé ça et là. Mais ça ne fonctionne pas vraiment. quelqu'un pourrait-il m'aider. merci
Sub Supercopier()
Dim wbdest As Workbook
Dim wbsource As Workbook
Dim i As Integer

Set wbdest = ActiveWorkbook

fichier = Dir("C:\Mes documents\source\*.xlsx")

Do While fichier <> ""

Workbooks(fichier).Open

Date = wbsource.Worksheets(RJA).Cells(K5).Value
For i = 0 To wbdest.Worksheets(PRESENCE_AGENTS).Rows.Count
If wbdest.Worksheets(PRESENCE_AGENTS).Cells(2 + i, 1) = Date Then
wbdest.Worksheets(PRESENCE_AGENTS).Cells(2 + i, 2) = wbsource.Worksheets(RJA).Cells(10, 2)
wbdest.Worksheets(PRESENCE_AGENTS).Cells(2 + i, 3) = wbsource.Worksheets(RJA).Cells(10, 3)
wbdest.Worksheets(PRESENCE_AGENTS).Cells(2 + i, 4) = wbsource.Worksheets(RJA).Cells(10, 7)
wbdest.Worksheets(PRESENCE_AGENTS).Cells(2 + i, 5) = wbsource.Worksheets(RJA).Cells(10, 8)
End If
Next

For i = 0 To wbdest.Worksheets(POINT_SECURITAIRE).Rows.Count
If wbdest.Worksheets(POINT_SECURITAIRE).Cells(2 + i, 1) = Date Then
wbdest.Worksheets(POINT_SECURITAIRE).Cells(2 + i, 2) = wbsource.Worksheets(RJA).Cells(16, 2)
wbdest.Worksheets(POINT_SECURITAIRE).Cells(2 + i, 3) = wbsource.Worksheets(RJA).Cells(16, 5)
End If
Next

For i = 0 To wbdest.Worksheets(TONNAGE_JOURNALIER).Rows.Count
If wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 1) = Date Then
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 2) = wbsource.Worksheets(RJA).Cells(44, 3)
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 3) = wbsource.Worksheets(RJA).Cells(47, 3)
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 4) = wbsource.Worksheets(RJA).Cells(46, 3)
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 5) = wbsource.Worksheets(RJA).Cells(49, 3)
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 6) = wbsource.Worksheets(RJA).Cells(48, 3)
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 7) = wbsource.Worksheets(RJA).Cells(45, 3)
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 8) = wbsource.Worksheets(RJA).Cells(52, 3)
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 9) = wbsource.Worksheets(RJA).Cells(51, 3)
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 10) = wbsource.Worksheets(RJA).Cells(53, 3)
wbdest.Worksheets(TONNAGE_JOURNALIER).Cells(3 + i, 11) = wbsource.Worksheets(RJA).Cells(50, 3)
End If
Next

wbsource.Close 'close the current source file
fichier = Dir 'go to next file in the directory
Loop 'restart the process with next file
wbdest.Activate

End Sub

 

[Yaloo]

Re : copier des données de fichiers excel d'un repertoire X vers un autre fichier

Bonsoir berni et bienvenu sur XLD,

Le mieux serait de mettre un ou plusieurs fichiers (anonymisés) avec des exemples. Ce serait plus facile pour t'aider.

A te relire

Martial