Microsoft 365 Executer un code dans un autre fichier VBA

[Faroyo]

Bonjour,
j'aurai besoin de votre aide pour comprendre comment résoudre mon pb.
J'ai un fichier A dans le lequel j'ai mon code, fichier ouvert. A l'aide d'un code VBA, j'aimerai savoir si il est possible à partir du fichier A, d' ouvrir un fichier B et dans ce fichier, supprimer toutes les lignes différentes de la valeur 10 dans un la colonne E.
Comment executer le code se trouvant dans le fichier A pour modifier le fichier B.
Merci pour votre aide

 

[Dranreb]

Bonjour.
Ça pourrait être quelque chose de ce genre :

Sub Test()
   Dim Wbk As Workbook
   Set Wbk = Workbooks.Open("B.xlsx")
   LignesOùRelat(Wbk.Worksheets(1).Rows(2), "E", "<>", 10).Delete
   End Sub
Function ColLignesOùRelat(ByVal CelDéb As Range, ByVal ColQuoi, ByVal OPé As String, ByVal Valeur) As Range
Rem. ——— Cellules partant de CelDéb dans sa colonne où la colonne ColQuoi est en relation Opé avec Valeur.
   On Error Resume Next
   Set ColLignesOùRelat = Intersect(LignesOùRelat(CelDéb, ColQuoi, OPé, Valeur), CelDéb.EntireColumn)
   End Function
Function LignesOùRelat(ByVal LigneDéb As Range, ByVal ColQuoi, ByVal OPé As String, ByVal Valeur) As Range
Rem. ——— Lignes entières partant de LigneDéb où la colonne ColQuoi est en relation Opé avec une Valeur.
   If Not IsNumeric(ColQuoi) Then ColQuoi = LigneDéb.Worksheet.Columns(ColQuoi).Column
   If VarType(Valeur) = vbString Then Valeur = """" & Replace(Valeur, _
      """", """""") & """" Else Valeur = Trim$(Str$(Valeur))
   On Error Resume Next
   Set LignesOùRelat = LignesOùCondR1C1(LigneDéb, CondR1C1:="RC" & ColQuoi & OPé & Valeur)
   End Function
Function ColLignesOùCondR1C1(ByVal CelDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Cellules partant de CélDéb dans sa colonne dont les lignes vérifient une condition R1C1 CondR1C1.
   On Error Resume Next
   Set ColLignesOùCondR1C1 = Intersect(LignesOùCondR1C1(CelDéb, CondR1C1), CelDéb.EntireColumn)
   End Function
Function LignesOùCondR1C1(ByVal LigneDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Lignes entières partant de LigneDéb vérifiant une condition R1C1 CondR1C1.
   Dim Rng As Range
   Set Rng = PlageÀPartirDe(LigneDéb.EntireRow): If Rng Is Nothing Then Exit Function
   Set Rng = Rng.Columns(Rng.Columns.Count + 2)
   Application.ScreenUpdating = False
   On Error Resume Next
   Rng.FormulaR1C1 = "=1/(" & CondR1C1 & ")"
   Set LignesOùCondR1C1 = Rng.SpecialCells(xlCellTypeFormulas, 1).EntireRow
   Rng.EntireColumn.Offset(, -1).Resize(, 2).Delete
   End Function
Function PlageÀPartirDe(ByVal CelDéb As Range) As Range
Rem. ——— Plage utilisée à partir de CelDéb.
   Dim NbrLig As Long, NBrCol As Long
   With CelDéb.Worksheet.UsedRange:
      NbrLig = .Row + .Rows.Count - CelDéb.Row
      NBrCol = .Column + .Columns.Count - CelDéb.Column
      If NbrLig <= 0 Or NBrCol <= 0 Then Exit Function
      End With
   Set PlageÀPartirDe = CelDéb.Resize(NbrLig, NBrCol)
   End Function
Function ColUti(ByVal PlageDép As Range, Optional ByVal LMin As Long, Optional ByVal CMin As Long) As Range
Rem. ——— Plage renseignée de plus qu'une chaîne vide à partir de PlageDép et ce seulement dans ses colonnes dans la UsedRange.
   Set ColUti = PlgUti(PlageDép, Intersect(PlageDép.Worksheet.UsedRange, PlageDép.EntireColumn), LMin, CMin)
   End Function
Function PlgUti(ByVal PlageDép As Range, Optional ByVal PlagExam As Range = Nothing, _
   Optional ByVal LMin As Long, Optional ByVal CMin As Long) As Range
Rem. ——— Plage renseignée de plus qu'une chaîne vide à partir de PlageDép dans PlageExam assumé UsedRange si non précisé.
   Dim LMax As Long, CMax As Long, NbL As Long, NbC As Long
   On Error GoTo RienTrouvé
   If PlagExam Is Nothing Then Set PlagExam = PlageDép.Worksheet.UsedRange
   LMax = PlagExam.Find("*", PlagExam.Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
   CMax = PlagExam.Find("*", PlagExam.Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
   On Error GoTo 0
   NbL = LMax - PlageDép.Row + 1: If NbL < LMin Then NbL = LMin
   NbC = CMax - PlageDép.Column + 1: If NbC < CMin Then NbC = CMin
   If NbL < 1 Or NbC < 1 Then GoTo CEstToutVide
   Set PlgUti = PlageDép.Resize(NbL, NbC)
   Exit Function
RienTrouvé: Resume CEstToutVide
CEstToutVide: Set PlgUti = Nothing
   End Function

 

[Faroyo]

Du tonnerre c'est juste parfait.
J'imaginais pas cela si compliqué. En tout cas un grand merci.
Reste plus qu'a essayer de comprendre tuot cela.

Merci pour votre aide.

 

[Dranreb]

La procédure n'est pas si compliquée, et très courte.
Ce sont les fonctions de service que j'ai reprises de mes outils qui le sont un peu plus, mais leur utilisation est bien documentée par un commentaire au début de chacune.

 

[Faroyo]

En tout cas, merci pour votre aide et votre code commenté.

 

[Faroyo]

J'aurai encore une question pour vous.
Je souhaiterai à present extraire une donnée du fichier B à partir d'une valeur commune entre les deux fichiers. Je pensais faire un vlookup mais est-ce bien judicieux

 

[Dranreb]

Probablement, oui.
Vous pouvez aussi utiliser WorksheetFuntion,Match pour trouver la ligne à restituer.

 

[Faroyo]

Ok.
Merci beaucoup.
Je vous souhaite une tres bonne soirée.