Discussion :

[Micdewe]

Bonjour,

Je viens de passer 1h sur le site pour essayer de trouver une réponse à ma question... Sans succès, je me lance donc une nouvelle discussion.

Voilà, je suis en train d'écrire une macro qui prend des données dans un fichier qui est mis à jour quotidiennement et les colles dans un autre fichier qui reprend ces données pour toute l'année. En d'autre termes;

-365 fichiers d'information (un par jour) = [Fichier Quotidien XXX]
-1 fichier reprenant ces information pour toutes l'année = [Fichier Annuel]

Ma macro devrait inscrire les données reprise du [Fichier Quotidien 001] sur la ligne 001 du [Fichier Annuel] pour le jour 001. Le lendemain, les données du [Fichier Quotidien 002] sur la ligne 002 du [Fichier Annuel].

La difficulté pour moi est d'arriver à faire varier la ligne dans laquelle les données doivent être écrites en fonction du jour.

Quels idées pourriez-vous me donner pour y parvenir?

Merci d'avance!

[vpovpo]

Si k = numéro de la ligne sur laquelle tu veux écrire, on fait une boucle sur les colonnes. Par ex.:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For j = 1 To jmax
    ActiveSheet.Cells(k, j).Value = <valeur colonne j à copier>
Next j

[MarcelG]

Bonjour micdewe,

Il te faut tout d'abord une rigueur absolue dans la gestion de tes fichiers quotidiens et des zones de ton fichier annuel qui vont recevoir ces données.

Exemple fichier quotidien appelé monfichier_001.xls

Nom de la cellule réceptice dns le fichier annuel coll_001.

Tu pourras aisément ainsi gérer les

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

destination

de chaque méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

copy

par la propriété

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Thisworkbook.Name

Confirme d'abord si tes fichiers sont ainsi normés.

[tedo01]

Bonjour,
Autre possibilité, faire un lien entre les fichiers quotidiens et annuels par des formules dans le fichier annuel. Par exemple, pour copier en colonne A les données des cellules B2 de l'onglet Feuille1 de chaque fichier quotidien, mettre dans la cellule A1 la formule suivante et la tirer plus bas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=INDIRECT("'[Fichier Quotidien " & TEXTE(LIGNE(A1);"000") & ".xls]Feuille1'!$B$2")

[MarcelG]

Bonjour tedoo,

Je crains que 365 liaisons soient lourdes à gérer.

J'opterais plus pour une copie brute, tout en sachant que chaque macro puisse être lancée d'une façon ou d'une autre (évènement ou déclenchement manuel)

Par exemple, si le fichier source se nomme

Copy_micdewe_001.xls

En adaptant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Macro1()
    Dim fichdest As Workbook, celdest As String
    Workbooks.Open Filename:="Copy_micdewe_annuel.xls"
    Set fichdest = ActiveWorkbook
    celdest = "col_" & Mid(ThisWorkbook.Name, 14, 3)
    ThisWorkbook.Sheets(1).Range("A1:F10").Copy Destination:=fichdest.Sheets(1).Range(celdest)
    fichdest.Close (True)
    Application.CutCopyMode = False
End Sub

[Micdewe]

Bonsoir,

Merci pour la rapidité de vos commentaires! Ci-dessous mes réactions;

MarcelG: concernant la rigueur des fichier; j'en suis bien conscient. J'y travaille. Pour la petite histoire: le pépin, c'est que cela ne dépend pas de moi, mais je pousse dans ce sens. Pour contourner le problème, pour le moment je demande à l'utilisateur à travers une BDi de sélectionner le [Fichier Quotidien] de rigueur et de donner la date correspondante au données.

Tedo01, je suis aussi du même avis que MarcelG; une copie brute chaque jour est préférable.

MarcelG: si je comprends bien tes quelques lignes de codes la macro se trouverait dans les fichiers quotidiens? Moi je la voyais plutôt dans le fichier annuel...

En tout cas tout cela m'aide déjà pas mal. Je re-posterai ici plus tard, dès que j'aurai pu faire quelques tests en plus.

[mercatog]

Une proposition exemple à adapter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Import()
Dim wbk As Workbook
Dim Fichier As Variant
Dim NewLig As Long
 
Application.ScreenUpdating = False
Fichier = Application.GetOpenFilename("Excel Files (*.xls), *.xls")
If Fichier <> False Then
   Set wbk = Workbooks.Open(Fichier)
   With ThisWorkbook.Worksheets(1)
      'Exemple on va copier A1:M1 à partir du fichier quotidien vers la première ligne vide du fichier synthèse
      NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
      wbk.Worksheets(1).Range("A1:M1").Copy .Range("A" & NewLig)
   End With
   Set wbk = Nothing
End If
End Sub

[MarcelG]

Bonjour le Forum, micdewe
Bonjour mercatog (ravi de te retrouver)

J'ais aussi récupéré ce type de code afin de balayer les fichiers d'un répertoire.

Je livre en brut. A ADAPTER donc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim nb As Integer
Dim colle As Range
 
Public Sub Import()
        Dim chemin As String
        Application.ScreenUpdating = False
        nb = 0
        Application.ScreenUpdating = False
        chemin = ThisWorkbook.Path
        Lister chemin
End Sub
 
Public Function Lister(chemin As String)
Dim fs, Rep As Variant, NewRep As String, Nomfich As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Lister = fs.GetFolder(chemin).Files.Count
    Nomfich = Dir(chemin & "\*.xls")
    Do While Nomfich <> ""
            If InStr(Nomfich, Left(ThisWorkbook.Name, 5)) > 0 And InStr(Nomfich, "Cumul") = 0 Then
                    nb = nb + 1
                    Workbooks.Open chemin & "\" & Nomfich
                    ActiveSheet.Range("A1").CurrentRegion.Copy
                    ThisWorkbook.Activate
                    Sheets(Left(Nomfich, 11)).Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
                    Application.CutCopyMode = False
                    Workbooks(Nomfich).Close (False)
            End If
            Nomfich = Dir()
    Loop
    'Pour chaque sous-répertoire, appel récursif de Lister
    'For Each Rep In fs.GetFolder(chemin).SubFolders
    '   NewRep = Lister(Rep.Path)
    'Next Rep
    End Function