Macro pour plusieurs fichiers

Le 24/07/2010 à 12:16

bonjour,

j'ai une macro pour insérer une ligne avec recopiage de formule ( les formules se situent en colonnes W; X ; Y )qui est valable pour un fichier A,

j'aimerai que cette macro puisse insérer la même ligne au même endroit dans plusieurs autres fichiers ( +- 25 )

tout en sachant que les 7 premières colonnes des fichiers à rajouter sont en liaisons avec le fichier A

ma question est la suivante : en insérant une ligne dans le fichier A est ce que les liaisons dans les autres fichiers seront toujours correctes et si cela est posssible comment faire

et comment faire pour que la macro soit valable pour mes 25 autres fichiers

merci d'avance pour votre attention

AUBA

Le 24/07/2010 à 14:22

Bonjour Auba,

Pour voir ma solution, il faut que tu charges dans un dossier :

- les 3 classeurs dans lesquels il faut ajouter une ligne. N'ouvrir aucun de ces fichiers : c'est la macro qui se chargera de les ouvrir !

- le classeur macro qui va agir sur ces 3 fchiers. Ce fichier là doit être ouvert. Modifie dans la macro le chemin qui permet d'accéder à ces 3 fichiers puis il te suffit de cliquer sur le bouton "Lance le traitement".

Ci-joint les 4 fichiers annoncés :

52solution.zip (16.68 Ko)

Cela repose sur la macro suivante :

Public NumLigne As String
Sub InsertLigneAvecFormules()

    'Ouverture des fichiers à impacter
    '---------------------------------
    Workbooks.Open Filename:="C:\ ... \Fichier 01.xls"
    Range("A1").Select
    Workbooks.Open Filename:="C:\ ... \Fichier 02.xls"
    Range("A1").Select
    Workbooks.Open Filename:="C:\ ... \Fichier 03.xls"
    Range("A1").Select

    'Après quel N° de ligne faut-il rajouter une nouvelle ligne ?
    '-----------------------------------------------------------
Recommence:
    NumLigne = InputBox("Après quel N° de ligne faut-il rajouter une nouvelle ligne ?", Question)
    If Not IsNumeric(NumLigne) Then GoTo Recommence

    Windows("Fichier 01.xls").Activate
    Call Routine
    Windows("Fichier 02.xls").Activate
    Call Routine
    Windows("Fichier 03.xls").Activate
    Call Routine

    MsgBox "La nouvelle ligne a été ajoutée sur tous les fichiers !"

End Sub

Sub Routine()

    'Insertion d'une nouvelle ligne
    '------------------------------
    Cells(NumLigne + 1, 1).Select
    Selection.EntireRow.Insert

    'Copie des formules se trouvant en colonne X, X et Y sur la nouvelle ligne
    '-------------------------------------------------------------------------
    Range(Cells(NumLigne, 23), Cells(NumLigne, 25)).Select
    Selection.Copy
    Range(Cells(NumLigne + 1, 23), Cells(NumLigne + 1, 25)).Select
    ActiveSheet.Paste

    Application.CutCopyMode = False
    Range("A1").Select

End Sub
Le 25/07/2010 à 11:10

Bonjour Marmotte18,

je viens de tester ta proposition, elle est remarquable mais j'ai encore 3 questions sur ta proposition.

dans ma demande j'avais signalé que les 7 premières colonnes étaient en liaisons et lorsque je teste il n'y a pas de liaison dans la ligne insérée

lorsque le message box qui demande le numéro de ligne pour inserer une nouvelle ligne apparait on ne peut pas annuler

dernier détail, est il possible que les fichiers ne s'ouvrent pas tous automatiquement car il y en a 25 et cela est trop lourd, est il possible de pouvoir choisir les fichiers à ouvrir via une liste déroulante

encore merci d'avance

AUBA

Le 25/07/2010 à 11:45

Bonjour AUBA,

Tu as dit : dans ma demande j'avais signalé que les 7 premières colonnes étaient en liaisons et lorsque je teste il n'y a pas de liaison dans la ligne insérée

Le problème est que tu n'as transmis aucun fichier Excel permettant d'effectuer des tests. Par ailleurs, je n'ai pas non plus d'information sur la nature de ces liaisons. De ce fait, je peux difficilement voir ce que l'on peux faire !

Tu as dit : lorsque le message box qui demande le numéro de ligne pour inserer une nouvelle ligne apparait on ne peut pas annuler

C'est effectivement une amélioration nécessaire que je peux apporter :

Recommence:
    NumLigne = InputBox("Après quel N° de ligne faut-il rajouter une nouvelle ligne ?", "Question")
    If NumLigne = "" Then MsgBox "ABANDON DU TRAITEMENT !": Exit Sub
    If Not IsNumeric(NumLigne) Then GoTo Recommence
Tu as dit : dernier détail, est il possible que les fichiers ne s'ouvrent pas tous automatiquement car il y en a 25 et cela est trop lourd, est il possible de pouvoir choisir les fichiers à ouvrir via une liste déroulante

Dans ton problème d'origine, je n'ai pas fait attention au fait qu'il ne s'agissait pas de créer un enregistrement sur l'ensemble de tes fichiers mais seulement sur un ou plusieurs et jusqu'à concurrence de 25. Désolé, j'ai mal lu !

Je veux bien me pencher sur le problème mais il n'est pas sûr que j'y arrive.

Par ailleurs, l'envie de rajouter une nouvelle ligne vient-il toujours du Fichier 01 ? En tous les cas, c'est comme ça qu'a été conçue la macro.

-- 25 Juil 2010, 19:01 --

Bonsoir AUBA,

Je te joins une 2e version de ma proposition.

Fichier 01, Fichier 02 et Fichier 03 sont les mêmes qu'au début !

Dans ThisWorkBook, je mets :

Private Sub Workbook_Open()

'Réinitialise la table interne et les choix de la ListBox quand on ouvre le fichier
'----------------------------------------------------------------------------------
With Sheets("Feuil1").ListBox1
    For I = 0 To .ListCount - 1
        Fichier(I) = ""
        If .Selected(I) = True Then .Selected(I) = False
    Next I
End With

End Sub

Dans Feuil1, je mets :

Private Sub ListBox1_Change()

'Remplissage du choix fait dans la liste déroulante des fichiers à ouvrir
'------------------------------------------------------------------------
Dim Choix As Byte

With Sheets("Feuil1").ListBox1
    For Choix = 0 To .ListCount - 1
        If .Selected(Choix) = True Then
            Fichier(Choix) = "Fichier" & Right("00" & (Choix + 1), 2)
        Else
            Fichier(Choix) = ""
        End If
    Next Choix
End With

End Sub
Private Sub CommandButton1_Click()

'Réinitialise la table interne et les choix de la ListBox quand on clique sur le bouton "réinitialise"
'-----------------------------------------------------------------------------------------------------
With Sheets("Feuil1").ListBox1
    For I = 0 To .ListCount - 1
        Fichier(I) = ""
        If .Selected(I) = True Then .Selected(I) = False
    Next I
End With

End Sub

Dans Module1, je mets :

Public NumLigne As String, Fichier(2) As Variant
Sub InsertLigneAvecFormules()

    Dim Ctr As Byte, F As Byte

    'Ouverture des fichiers à impacter
    '---------------------------------
    For F = 0 To 2
        Select Case Fichier(F)
            Case "Fichier01"
            Ctr = Ctr + 1
            Workbooks.Open Filename:="C:\ ... \Fichier 01.xls"
            Range("A1").Select

            Case "Fichier02"
            Ctr = Ctr + 1
            Workbooks.Open Filename:="C:\ ... \Fichier 02.xls"
            Range("A1").Select

            Case "Fichier03"
            Ctr = Ctr + 1
            Workbooks.Open Filename:="C:\ ... \Fichier 03.xls"
            Range("A1").Select
        End Select
    Next F

    If Ctr = 0 Then MsgBox "Aucun fichier n'a été sélectionné => ABANDON DU TRAITEMENT !": Exit Sub

    'Après quel N° de ligne faut-il rajouter une nouvelle ligne ?
    '-----------------------------------------------------------
Recommence:
    NumLigne = InputBox("Après quel N° de ligne faut-il rajouter une nouvelle ligne ?", "Question")
    If NumLigne = "" Then MsgBox "ABANDON DU TRAITEMENT !": Exit Sub
    If Not IsNumeric(NumLigne) Then GoTo Recommence

    For F = 0 To 2
        Select Case Fichier(F)
            Case "Fichier01"
            Windows("Fichier 01.xls").Activate
            Call Routine

            Case "Fichier02"
            Windows("Fichier 02.xls").Activate
            Call Routine

            Case "Fichier03"
            Windows("Fichier 03.xls").Activate
            Call Routine
        End Select
    Next F

    MsgBox "La nouvelle ligne a été ajoutée sur tous les fichiers !"

End Sub

Sub Routine()

    'Insertion d'une nouvelle ligne
    '------------------------------
    Cells(NumLigne + 1, 1).Select
    Selection.EntireRow.Insert

    'Copie des formules se trouvant en colonne X, X et Y sur la nouvelle ligne
    '-------------------------------------------------------------------------
    Range(Cells(NumLigne, 23), Cells(NumLigne, 25)).Select
    Selection.Copy
    Range(Cells(NumLigne + 1, 23), Cells(NumLigne + 1, 25)).Select
    ActiveSheet.Paste

    Application.CutCopyMode = False
    Range("A1").Select

End Sub
43macro-fichiers-01-a-03-version-2.zip (15.58 Ko)
Rechercher des sujets similaires à "macro fichiers"