Calcul sur un fichier A à partir d'une recherchev sur fichier B

Bonjour à tous,

Je suis en pleine initiation vba mais je bloque sur une problématique assez particulière.

J’ai un fichier(source) sur lequel je calcule une évolution selon les données d’un autre fichier(données).

N-B : les deux fichiers ont plusieurs onglets et je veux répéter cette opération pour chaque onglet

Ex : « Cell(« I3 ») – Recherchev( A3 ; nom du fichier=fichier de données/nom de l’onglet/plage ; 6 ; faux)

Pour l’heure j’ai réussi (tant bien que mal) à sélectionner le fichier à ouvrir, appliquer la mise en forme souhaitée, sélectionner les plages où copier ma formule (formule obtenue via l’enregistreur de macro)

Je souhaiterais désormais que :

• Nom de fichier : se rapporte au fichier que j’ai ouvert
• Nom de l’onglet : se fasse par une recherche en fonction du libellé situé en « B1 » du fichier source

J’ai beau cherché, je ne trouve pas la bonne syntaxe pour réaliser ceci (si c’est possible). Ma formule est en gras dans le code ci-dessous

Sub OuvreMulti()

Evolution = MsgBox("Souhaitez vous calculer l'évolution par rapport à la semaine précédente ?", vbYesNo + vbQuestion)

    If Evolution = vbNo Then
        Exit Sub
    Else

Worksheets(1).Activate

        r = Sheets.Count
        For Z = 1 To r
        On Error Resume Next
            Worksheets(Z).Range("I2").Select
            Selection.Value = "Evolution vs semaine précédente"
            Selection.WrapText = True
            Selection.HorizontalAlignment = xlCenter
            Selection.VerticalAlignment = xlBottom
            Selection.ColumnWidth = 15
            ActiveSheet.Next.Select

            Next Z

    Dim WkbS As Workbook, WkbC As Workbook
    Dim LeFichier As String

    Set WkbS = Application.Workbooks(2) 'Affecte à WkbS (source) le fichier actif, qui contient la macro

    LeFichier = Application.GetOpenFilename("Fichier Excel (*.xls*), *.xls*")
        If LeFichier <> "False" Then
            Application.Workbooks.Open LeFichier
        Set WkbC = ActiveWorkbook 'Affecte la variable ou fichier qui vient d'être ouvert, donc de l'utilisateur
        Else
        MsgBox ("Vous venez d'annuler la macro"), vbExclamation
        Exit Sub

        End If

'A partir d'ici tu peux utiliser les variables WkbS et WkbC

WkbS.Sheets(1).Activate
Range("i3").Select

    rr = Sheets.Count

    For zz = 1 To rr

Dim DerLigne As Long

DerLigne = Range("A" & Rows.Count).End(xlUp).Row
Selection.AutoFill Destination:=Range("A3:A" & DerLigne).Select
Selection.Offset(0, 8).Select

[b]Selection.FormulaR1C1 = "=RC[-3]-VLOOKUP(RC[-8],'[RG_Suivi T2 au 021819v3.xlsx]19-T1-BAUME SOLAIRE'!R3C1:R28C8,6,FALSE)"[/b]

    ActiveSheet.Next.Select

Next

End If

End Sub

Merci à ceux qui pourront m'aider, en espérant avoir été suffisamment clair...

Petit up au moins pour savoir si c'est faisable...

Merci par avance!

Roginou a écrit :

Petit up au moins pour savoir si c'est faisable...

Merci par avance!

Je vous joins 2 fichiers comme modèle avec l'onglet exemple et le résultat attendu en colonne "i" (j'espère que les liaisons entre fichiers fonctionnent toujours)

Bonsoir,

Essayer ce code :

Option Explicit

Sub OuvreMulti()
    Dim LeFichier As String, plage_feuille_fichierB As String
    Dim WkbC As Workbook
    Dim feuille As Worksheet
    Dim DerLigne As Long

    If MsgBox("Souhaitez vous calculer l'évolution par rapport ? la semaine précédente ?", vbYesNo + vbQuestion) = vbNo Then Exit Sub

    LeFichier = Application.GetOpenFilename("Fichier Excel (*.xls*), *.xls*")
    If LeFichier = "False" Then MsgBox ("Vous venez d'annuler la macro"), vbExclamation: Exit Sub

    Set WkbC = Workbooks.Open(LeFichier)    'Assigne le fichier qui vient d'être ouvert

    For Each feuille In ThisWorkbook.Worksheets
        On Error Resume Next
        plage_feuille_fichierB = WkbC.Sheets(feuille.Name).UsedRange.Address(1, 1, xlR1C1, 1)
        If Err.Number = 0 Then
            With feuille
                .Columns("F").Copy: .Columns("I").PasteSpecial (xlPasteFormats)
                .Range("I2") = "Evolution vs semaine précédente"
                .Range("I2").WrapText = True
                DerLigne = .Range("A" & Rows.Count).End(xlUp).Row
                With Range(.Cells(3, "I"), .Cells(DerLigne, "I"))
                    .FormulaR1C1 = "=RC[-3]-VLOOKUP(RC[-8]," & plage_feuille_fichierB & ",6,FALSE)"
                End With
            End With
        End If
    Next feuille

    WkbC.Close SaveChanges:=False

End Sub

NB : ThisWorkBook représente toujours le classeur où s'exécute le code

Bonjour Thev et merci pour ton retour,

Je viens d'essayer le code que tu as transmis mais il ne se passe rien du tout après l'ouverture du fichierB... la macro tourne, le fichier se ferme mais rien n’apparaît dans mon fichierA.

Roginou a écrit :

Je viens d'essayer le code que tu as transmis mais il ne se passe rien du tout après l'ouverture du fichierB... la macro tourne, le fichier se ferme mais rien n’apparaît dans mon fichierA.

Dans quel fichier se trouve la macro ??

D'après ce que tu dis, c'est dans le fichier A

Roginou a écrit :

Fichier A.xls

Fichier de travail sur lequel la macro s'exécute

En tout cas, chez moi, ça fonctionne.

La macro est dans mon classeur de macros personnelles, car le fichier de travail est généré à partir d'une extraction d'un de nos logiciels. Je réalise une nouvelle extraction par semaine.

Si j'ai bien compris le fonctionnement des macros, si j'écris le code dans le classeur du fichier de travail, je ne la retrouverai pas lorsque je réaliserai une nouvelle extraction la semaine suivante. Est-ce bien ça?

Bonjour,

OK. C'est plus clair.

ci-dessous code modifié en conséquence

Option Explicit

Sub OuvreMulti()
    Dim LeFichier As String, plage_feuille_fichierB As String
    Dim classeur As Workbook, WkbS As Workbook, WkbC As Workbook
    Dim feuille As Worksheet
    Dim DerLigne As Long

    For Each classeur In Workbooks
        If Not classeur Is ThisWorkbook Then Set WkbS = classeur
    Next classeur
    If MsgBox("Souhaitez vous calculer l'évolution par rapport à la semaine pr?c?dente ?", vbYesNo + vbQuestion) = vbNo Then Exit Sub

    LeFichier = Application.GetOpenFilename("Fichier Excel (*.xls*), *.xls*")
    If LeFichier = "False" Then MsgBox ("Vous venez d'annuler la macro"), vbExclamation: Exit Sub

    Set WkbC = Workbooks.Open(LeFichier)    'Assigne le fichier qui vient d'être ouvert

    For Each feuille In WkbS.Worksheets
    On Error Resume Next
        plage_feuille_fichierB = WkbC.Sheets(feuille.Name).UsedRange.Address(1, 1, xlR1C1, 1)
        If Err.Number = 0 Then
            With feuille
                .Columns("F").Copy: .Columns("I").PasteSpecial (xlPasteFormats)
                .Range("I2") = "Evolution vs semaine pr?c?dente"
                .Range("I2").WrapText = True
                DerLigne = .Range("A" & Rows.Count).End(xlUp).Row
                With Range(.Cells(3, "I"), .Cells(DerLigne, "I"))
                    .FormulaR1C1 = "=RC[-3]-VLOOKUP(RC[-8]," & plage_feuille_fichierB & ",6,FALSE)"
                End With
            End With
        End If
    Next feuille

    WkbC.Close SaveChanges:=False

End Sub

Merci Thev pour ton retour et le temps que tu m'as accordé!

Je viens d'essayer le nouveau code, il fonctionne parfaitement à une exception lorsque j'essaie de lancer ma macro à partir d'un fichier excel .xls et de récupérer un fichier .xlsx, la macro s'exécute en me renommant les cellules avec "Evolution vs semaine précédente" mais s’arrête à ça sans me remonter d'erreur particulière. Est-ce dû à un problème de compatibilité entre xls et xlsx?

Encore merci pour ton aide

Roginou a écrit :

j'essaie de lancer ma macro à partir d'un fichier excel .xls et de récupérer un fichier .xlsx, la macro s'exécute en me renommant les cellules avec "Evolution vs semaine précédente" mais s’arrête à ça sans me remonter d'erreur particulière.

Quelle est exactement la situation ?

1- classeur macros personnelles en .xls

2- fichier A en .xlsx

3- fichier B en .xls

Combien de classeurs ouverts avant l'ouverture du fichier B ?