[Excel | VBA] Enregistrer données dans 2 classeurs différents à la fois

Bonjour tout le monde,

Je cherche à faire une manipulation un peu hasardeuse.
En fait, j'ai 2 classeurs ( GestionFIQ.xls et bddFIQ.xls ), ce que je souhaite faire c'est que lorsque j'ai uniquement mon classeur GestionFIQ.xls d'ouvert et qu'à partir d'un formulaire de celui ci j'insère des données dans une feuille de ce classeur, cela ouvre l'autre classeur ( bddFIQ.xls ) et que ca insère les mêmes données, puis referme le classeur.

Mon bout de code actuel permet une seule écriture ( sur le classeur en cours, là ou se trouve le formulaire )

Sub Extraction()

'extrait les informations d'une FNC pour créer le début de la FIQ
 
   Dim ProchaineLigneVide As Long
   Dim FileToOpen As Variant
   Dim mes1 As Variant
   Dim marecherche As String
   Dim No As String
   Dim Ws As Worksheet
  
    Select Case design_pays
        Case "FR"
            mes1 = "Importation annulée !"
            mes2 = "Ce classeur ne contient pas de F.N.C. !"
           
        Case "GB"
            mes1 = "Importation cancelled !"
            mes2 = "This workbook doesn't have N.C.S. !"
    End Select
   
On Local Error GoTo MyOpen
    FileToOpen = Application.GetOpenFilename("Tout les fichiers Excel (*.xl*;*.xls;*.xla;*.xml;*.xlm;*.xlc;*.xlw),")
    Module5.NoFIQ
    If FileToOpen Then
MyOpen:
        If Err.Number = 13 Then
            Err.Clear: On Local Error GoTo 0
            Workbooks.Open FileToOpen
        End If
               
  For Each Ws In ActiveWorkbook.Worksheets
           If UCase$(Ws.Name) = "FICHE FR" Or UCase$(Ws.Name) = "FICHE GB" Then
               Exit For
       Else
       ActiveWorkbook.Close
       MsgBox mes2
       Exit Sub
       End If
   Next
  
       marecherche = Ws.Range("O10").Value
  
       With ThisWorkbook.Sheets("Liste Fournisseurs").Range("a:a")
           Set c = .find(marecherche, LookIn:=xlValues)
       End With
       If c Is Nothing Then Call Module1.affiche_fournisseur
           With ThisWorkbook.Sheets("recep")
               ProchaineLigneVide = .Range("A65536").End(xlUp).Row + 1
     
               .Range("A" & ProchaineLigneVide).Value = Workbooks("GestionFIQ.xls").Sheets("Présentation").Range("E100").Value
               .Range("B" & ProchaineLigneVide).Value = Ws.Range("D11").Value
               .Range("C" & ProchaineLigneVide).Value = Ws.Range("D10").Value
               .Range("D" & ProchaineLigneVide).Value = Ws.Range("O10").Value
               .Range("E" & ProchaineLigneVide).Value = Ws.Range("P2").Value
               .Range("F" & ProchaineLigneVide).Value = Ws.Range("B16").Value
               .Range("G" & ProchaineLigneVide).Value = Workbooks("gestionfiq.xls").Sheets("Liste Fournisseurs").Range("g1").Text
               .Range("H" & ProchaineLigneVide).Value = Workbooks("gestionfiq.xls").Sheets("Liste fournisseurs").Range("g2").Text
           End With
                 
    No = Workbooks("GestionFIQ.xls").Sheets("présentation").Range("E100").Value
       
    MsgBox ("Nouvelle F.I.Q. N° " & No)
    ActiveWorkbook.Close
Exit Sub

    End If
    MsgBox mes1
End Sub


Merci d'avance d'avoir pris le temps de lire les explications et de prendre le temps de m'aider.

Cordialement,


AiDuK