Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 Besoin de modifier Workbooks("classeur1") selon le classeur ouvert

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous 🙂

Pour finaliser mon code, grâce à vous tous très avancé, il ne me reste plus qu'un code à trouver....
Je cherche mais pour l'instant, malgré mes tentatives et recherches, je n'ai pas encore trouvé.

contexte
4 classeurs peuvent être concernés par ce code :
- isitelFacturation Nouveau,
- classeur1,
- classeur2,
- classeur3
Seuls 2 de ces classeurs sont ouverts en même temps :
- isitelFacturation Nouveau et classeur1 ou classeur2 ou classeur3

Dans mon code il y a cette ligne :
ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("classeur1").Sheets("RendezVous").Range("L4:L500").Value
Je cherche à modifier Workbooks("classeur1") pour que ce soit les informations du "classeur qui est ouvert (NON actif) "qui soient collé dans mon classeur actif (sachant que le classeur actif est toujours : isitelFacturation Nouveau).

Auriez-vous le bon code ?
Si besoin, je ferai les classeurs test...
Merci à toutes et à tous 🙂

J'espère que mon explication sera compréhensible. Je reste à l'écoute pour eclairer si besoin 🙂
Pour les gardiens de la galaxie :
Les msg intempestifs, non constructifs, toujours gênants pour le fil et l'image de notre Forum, inutile de répondre, je ne donnerai pas suite.
🙂
 
Dernière édition:
Trier par date Trier par votes
bonjour à tous
juste en passant ,je reviens sur le truc là

pour moi la chose est simple
si tu n'a que 2 classeur d'ouverts en même temps

VB: 
sub machin
dim WBK1 as workbook , WBK2 as workBook
set WBK1= thisworkbook
for each wbk in workbooks
if wbk<> thisworkbook.name then set Wbk2=wbk
next
ActiveCell.Resize(499, 1) = wbk2.Sheets("RendezVous").Range("L4:L500").Value

'balablabla
end sub
et encore je boucle par ce qu'on sait pas le quel tu a ouvert en premier sinon ça serait plus simple encore
 
Dernière édition:
Vote positif 0 Vote négatif
Désolé ça beug.
Laisse pour l'instant, je suis sur une autre piste 🙂
 
Vote positif 0 Vote négatif
j'ai bien compris que mes proposition sont hors sujet mais naïvement je persiste😁
VB: 
Sub test()
Dim T() As String, i As Integer
T() = Split("isitelFacturation Nouveau,classeur1,classeur2,classeur3", ",")
If IsOpen(T(0)) Then
    For i = 1 To UBound(T)
        If IsOpen(T(i)) Then TraitementFichier Workbooks(T(i)), Workbooks(T(0)): Exit Sub
    Next
End If
End Sub
Function IsOpen(ByVal Classeur As String) As Boolean
On Error Resume Next
Classeur = Windows(Classeur).Caption
IsOpen = Not CBool(Err)
Err.Clear
On Error GoTo 0
End Function

Sub TraitementFichier(Source As Workbook, Cible As Workbook)
    With Cible.Sheets("TOTO")
            .Cells(.Rows.Count, "a").End(xlUp).Offset(IIf(CStr(.Cells("ci1")) = "", 3, 2)).Resize(499, 1) = Source.Sheets("RendezVous").Range("L4:L502").Value
            .Cells(.Rows.Count, "b").End(xlUp).Offset(IIf(CStr(.Cells("ci1")) = "", 4, 2)).Resize(499, 1) = Source.Sheets("RendezVous").Range("Q4:Q502").Value
    End With
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Merci Patrick 🙂
désolé, ça ne copie rien... Bon sang !
tu est sur que le Next est avant la ligne :
"ActiveCell.Resize(499, 1) = wbk2.Sheets("RendezVous").Range("L4:L500").Value

"et encore je boucle par ce qu'on sait pas le quel tu a ouvert en premier sinon ça serait plus simple encore"
Si je sais car je les traite toujours dans le même ordre :
1 - isitelImmobRdV ImenNF.xlsm - à la fin du traitement il est fermé et j'ouvre le suivant...
2 - isitelImmobRdV SondaNF.xlsm- à la fin du traitement il est fermé et j'ouvre le suivant...
3 - isitelImmobRdV StephanieNF
🙂
 
Vote positif 0 Vote négatif
Sincèrement, je te remercie pour ta gentille et constructive insistance 🙂
Je vais tester 🙂
 
Dernière édition:
Vote positif 0 Vote négatif
lol : c'est qui TOTO ?
Usine à gaz à dit:
Sincèrement, je te remercie pour ta gentille et constructive insistance 🙂
Je vais tester 🙂
Cliquez pour agrandir...
Maleueusement, ça ne traite pas, je suis désolé.
Faudrait que je prenne le temps de faire des fichiers tests.
J'essaierai ce WE ...
Mais j'ai pris tellement de retard dans mon travail, pas sûre que je sois dispo 🙂
 
Vote positif 0 Vote négatif
Il faut bien noté le nom de tes classeur par exemple :
Split("isitelFacturation Nouveau.xlsm,

Toto car je ne connais pas le nom du Sheets actif. Je n'utilise pas les select, sélection et autres activate ça engendre des erreurs.

Il faut bien que tu adapte à ton contexte
 
Vote positif 0 Vote négatif
En fait, je viens de trouver le bon code.
Si je le mets, vous allez me traiter de fol dingue lol.
Je mets quand même mon code tordu :
VB: 
Sub suiviRdVClients()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
  
    Dim wb As Workbook
    Dim ws As Worksheet
    'PREPARATION OUVERTUR FICHIER NOMME
    Set wb = Workbooks.Open("C:\Users\lionel\Desktop\01 isitelFacturation Nouveau\isitelFacturation Nouveau.xlsm") 'Préparation ouverture…
    Set ws = wb.Worksheets(1)
  
    Sheets("suiviRdV").Select
    ActiveSheet.Unprotect Password:=""
  
    [B1].FormulaR1C1 = "=SUM(R[3]C[27]:R[1500]C[27])"
    [G1].FormulaR1C1 = "=CONCATENATE(""Vendeur(s)"","" "",SUM(R[3]C[73]:R[1500]C[73]),"" / "", SUM(R[3]C[74]:R[1500]C[74]))"
    [Z1].FormulaR1C1 = "=CONCATENATE(""Nbr"","" "",SUM(R[3]C:R[1500]C))"
    [AB1].FormulaR1C1 = "=CONCATENATE(""lign"",""       "",SUM(R[3]C[54]:R[1500]C[54]))"
    [N2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [P2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [R2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [T2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [V2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [X2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [Y2].FormulaR1C1 = "=SUM(R[2]C[57]:R[1500]C[57])-SUM(R[2]C[55]:R[1500]C[55])-((SUM(R[2]C[57]:R[1500]C[57])-SUM(R[2]C[56]:R[1500]C[56])))"
    [AB2].FormulaR1C1 = "=CONCATENATE(SUM(R[2]C[52]:R[1500]C[52]),""            "",RC[54]-RC[53],""           "")"
    [AC2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [CB2].FormulaR1C1 = "=SUM(R[2]C:R[15000]C)"
    [CC2].FormulaR1C1 = "=SUM(R[2]C:R[15000]C)"
    [CD2].FormulaR1C1 = "=SUM(R[2]C:R[15000]C)"
  
     'C'EST LE 1er TRAITEMENT DU MOIS ?
    If MsgBox(" C'est le 1er traitement du mois ?" & Chr(10) & Chr(10) & "OUI         ou        NON", vbQuestion + vbYesNo) <> vbYes Then
        [ci1] = "En Cours"
        'Exit Sub
        Else
        [ci1] = ""
    End If
  
    'SI 1er TRAITEMENT
    If [ci1] = "" Then
    Rows("4:3000").ClearContents
    [B1].FormulaR1C1 = "=SUM(R[3]C[27]:R[1500]C[27])"
    [G1].FormulaR1C1 = "=CONCATENATE(""Vendeur(s)"","" "",SUM(R[3]C[73]:R[1500]C[73]),"" / "", SUM(R[3]C[74]:R[1500]C[74]))"
    [Z1].FormulaR1C1 = "=CONCATENATE(""Nbr"","" "",SUM(R[3]C:R[1500]C))"
    [AB1].FormulaR1C1 = "=CONCATENATE(""lign"",""       "",SUM(R[3]C[54]:R[1500]C[54]))"
    [N2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [P2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [R2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [T2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [V2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [X2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [Y2].FormulaR1C1 = "=SUM(R[2]C[57]:R[1500]C[57])-SUM(R[2]C[55]:R[1500]C[55])-((SUM(R[2]C[57]:R[1500]C[57])-SUM(R[2]C[56]:R[1500]C[56])))"
    [AB2].FormulaR1C1 = "=CONCATENATE(SUM(R[2]C[52]:R[1500]C[52]),""            "",RC[54]-RC[53],""           "")"
    [AC2].FormulaR1C1 = "=SUM(R[2]C:R[1500]C)"
    [CB2].FormulaR1C1 = "=SUM(R[2]C:R[15000]C)"
    [CC2].FormulaR1C1 = "=SUM(R[2]C:R[15000]C)"
    [CD2].FormulaR1C1 = "=SUM(R[2]C:R[15000]C)"
    End If
    [CI3].FormulaR1C1 = "=IF(RC[-85]="""","""",IF(RC[-1]=R[1]C[-1],"""",IF(LOOKUP(RC[-1],ClientsF)<>"""",LOOKUP(RC[-1],ClientsF),IF(RC[-85]<>"""",CONCATENATE(LOOKUP(RC[-1],Clients),"" "",LOOKUP(RC[-1],Clients1)),0))))"
    [CJ3].FormulaR1C1 = "=IF(RC[-86]="""",0,IF(RC[-2]<>R[-1]C[-2],1,R[-1]C+1))"
  
    'COPIE LIGNE MODELE
    Rows("3:3").Select
    Selection.RowHeight = 45
    [b3:e3].FormulaR1C1 = ""
    Selection.Copy
    ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).EntireRow.Select
    'ActiveCell.Rows.EntireRow.Select
    ActiveSheet.Paste
    [b3:e3].FormulaR1C1 = "1"
    Rows("3:3").RowHeight = 0
  
    'SI 1er TRAITEMENT
    If [ci1] = "" Then
        [M4:X500].ClearContents
        [Z4:Z500].ClearContents
        Else
        With Cells(Rows.Count, "A").End(xlUp)
        Rows(.Row).Copy Cells(.Row, "A").Offset(1).Resize(1500)
        Cells(.Row, "A").Offset(2).Select
        End With
      
        [A4:A2000].Replace What:="1", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        [a1].Select
    End If
  
    'SELECTION FICHIER RDdVs
    On Error Resume Next
    Windows("isitelImmobRdV ImenNF.xlsm").Activate
    Windows("isitelImmobRdV SondaNF.xlsm").Activate
    Windows("isitelImmobRdV StephanieNF.xlsm").Activate
    Sheets("RendezVous").Select
    ActiveSheet.Unprotect Password:="Krameri"
  
    'TRAITE PREPARATION DES RdVs A FACTURER
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=1,""OUI"",1)"
    Selection.Copy
    Range("B5:B500").Select
    ActiveSheet.Paste
    Range("B4:B500").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B4:B500").Select
    Selection.Replace What:=1, Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    On Error Resume Next
    Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    TrieMandatsOUI
  
    'REVIENT SUR FACTURATION
    Windows("isitelFacturation Nouveau.xlsm").Activate
    Sheets("suiviRdV").Select
    'SiActif
    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(3).Select
    Else
    ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("L4:L502").Value

    If [ci1] = "" Then
    'SI 1er TRAITEMENT
    ActiveSheet.Cells(Rows.Count, "b").End(xlUp)(4).Select
    Else
    'SI APRES er TRAITEMENT
    ActiveSheet.Cells(Rows.Count, "b").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("Q4:Q502").Value

    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "c").End(xlUp)(3).Select
    Else
    ActiveSheet.Cells(Rows.Count, "c").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("S4:S502").Value

    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "d").End(xlUp)(3).Select
    Else
    ActiveSheet.Cells(Rows.Count, "d").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("V4:V502").Value

    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "e").End(xlUp)(3).Select
    Else
    ActiveSheet.Cells(Rows.Count, "e").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("F4:F502").Value

    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "f").End(xlUp)(4).Select
    Else
    ActiveSheet.Cells(Rows.Count, "f").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("C4:C502").Value

    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "g").End(xlUp)(4).Select
    Else
    ActiveSheet.Cells(Rows.Count, "g").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("AD4:AD502").Value

    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "h").End(xlUp)(4).Select
    Else
    ActiveSheet.Cells(Rows.Count, "h").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("AE4:AE502").Value

    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "i").End(xlUp)(4).Select
    Else
    ActiveSheet.Cells(Rows.Count, "i").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("AF4:AF502").Value

    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "j").End(xlUp)(4).Select
    Else
    ActiveSheet.Cells(Rows.Count, "j").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("AG4:AG502").Value

    'ICI ICI ICI Ne prend pas les chiffres
    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "m").End(xlUp)(4).Select
    Else
    ActiveSheet.Cells(Rows.Count, "m").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("AI4:AT502").Value

    If [ci1] = "" Then
    [z4:z3000].ClearContents
    ActiveSheet.Cells(Rows.Count, "Z").End(xlUp)(3).Select
    Else
    ActiveSheet.Cells(Rows.Count, "AA").End(xlUp)(2).Select
    ActiveCell.Offset(0, -1).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 2) = Workbooks("isitelImmobRdV StephanieNF").Sheets("RendezVous").Range("A4:B502").Value
    Rows("503:3000").Delete
  
    Columns("Z:Z").Select
    Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
      
    [Y2].FormulaR1C1 = "=SUM(R[2]C[55]:R[500]C[55])"
    [AB1].FormulaR1C1 = "=CONCATENATE(""lign"",""       "",SUM(R[3]C[52]:R[1006]C[52]))"
    [AB2].FormulaR1C1 = "=CONCATENATE(SUM(R[2]C[52]:R[500]C[52]),""      "",SUM(R[2]C[53]:R[500]C[53]),""     "",SUM(R[2]C[-2]:R[500]C[-2]))"
  
    Rows("4:500").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  
    Rows("4:500").Select
    ActiveWorkbook.Worksheets("suiviRdV").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("suiviRdV").Sort.SortFields.Add2 Key:=Range( _
        "Z4:Z500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("suiviRdV").Sort
        .SetRange Range("A4:CJ500")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    [a1].Select
    Columns(26).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  
    Range("B3").Select
    Sheets("suiviRdV").Select '???
  
    On Error Resume Next
    Windows("isitelImmobRdV ImenNF.xlsm").Activate
    Windows("isitelImmobRdV SondaNF.xlsm").Activate
    Windows("isitelImmobRdV StephanieNF.xlsm").Activate
    ActiveWindow.SmallScroll Down:=-51
    Range("A2").Select
    Sheets("RendezVous").Select
    'RdVFin
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
    ActiveWindow.Close
End Sub
LOL, bricolage d'un bricoleur, n'applaudissez pas 😛🤣😇

Le souci qui me reste est de remplacer tous les "isitelImmobRdV StephanieNF" à chaque changement de fichier qui est ouvert.

Je sais, c'est long comme le bras et plus encore lol
🙂
 
Vote positif 0 Vote négatif
Re @Usine à gaz

VB: 
Sub SiActif()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    Dim Wb As Workbooks
    Dim Ws As Worksheet
    Dim LastRow As Long
 
    ' Cherche le workbook et la worksheet "RendezVous"
      On Error Resume Next
      Set Wb = Application.Parent.Workbooks
      For i = 1 To 2
        Set Ws = Wb.Item(i).Worksheets("RendezVous")
        If Err = 0 Then
            Set Ws = Wb.Item(i).Worksheets("RendezVous")
        Exit For
        End If
        Err = 0
      Next i
      On Error GoTo 0
    If Ws Is Nothing Then
     
        MsgBox "La feuille 'RendezVous' n'a pas été trouvée dans les autres classeurs.", vbExclamation
        Exit Sub
    End If
 
    ' Détermine la dernière ligne non vide de la colonne A
    LastRow = IIf([ci1] = "", ActiveSheet.Cells(Rows.Count, "A").End(xlUp)(3).Row, ActiveSheet.Cells(Rows.Count, "A").End(xlUp)(2).Row)
 
    ' Copie les données depuis la feuille Ws vers la feuille active
    ActiveSheet.Cells(LastRow, "A").Resize(499, 1).Value = Ws.Range("L4:L502").Value
    ActiveSheet.Cells(LastRow, "B").Resize(499, 1).Value = Ws.Range("Q4:Q502").Value
    ActiveSheet.Cells(LastRow, "C").Resize(499, 1).Value = Ws.Range("S4:S502").Value
    ActiveSheet.Cells(LastRow, "D").Resize(499, 1).Value = Ws.Range("V4:V502").Value
    ActiveSheet.Cells(LastRow, "E").Resize(499, 1).Value = Ws.Range("F4:F502").Value
    ActiveSheet.Cells(LastRow, "F").Resize(499, 1).Value = Ws.Range("C4:C502").Value
    ActiveSheet.Cells(LastRow, "G").Resize(499, 1).Value = Ws.Range("AD4:AD502").Value
    ActiveSheet.Cells(LastRow, "H").Resize(499, 1).Value = Ws.Range("AE4:AE502").Value
    ActiveSheet.Cells(LastRow, "I").Resize(499, 1).Value = Ws.Range("AF4:AF502").Value
    ActiveSheet.Cells(LastRow, "J").Resize(499, 1).Value = Ws.Range("AG4:AG502").Value
    ActiveSheet.Cells(LastRow, "M").Resize(499, 1).Value = Ws.Range("AI4:AT502").Value
 
    ' Efface le contenu de la plage Z4:Z3000 si nécessaire
    If [ci1] = "" Then
        [Z4:Z3000].ClearContents
        LastRow = ActiveSheet.Cells(Rows.Count, "Z").End(xlUp)(3).Row
    Else
        LastRow = ActiveSheet.Cells(Rows.Count, "AA").End(xlUp)(2).Row
    End If
 
    ' Copie les données depuis la feuille Ws vers la feuille active
    ActiveSheet.Cells(LastRow, "Z").Resize(499, 2).Value = Ws.Range("A4:B502").Value
 
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Merci Laurent 🙂
Je n'en peux plus.
S'il me reste des forces, je teste ce soir 🙂
 
Vote positif 0 Vote négatif
re
oui je suis sur ,car apres le next le WBK2 c'est le bon classeur si il est ouvert bien sur
 
Vote positif 0 Vote négatif
Bonjour à toutes et à tous 🙂
Bien que compliquée (comme souvent mes demandes), mon besoin était :
Rappel du contexte
- 3 classeurs (qui contiennent les informations à transférer).
Le code (identique) est dans chaque classeur puisqu'il s'exécute à partir de l'un de ces classeurs ouvert.
--- classeur1
--- classeur2
--- classeur3
- 1 classeur "récepteur" des informations contenues dans les 3 autres classeurs,
--- isitelFacturation Nouveau

Mon code initial était bon (certainement tordu mais bon)
Seuls 2 classeurs sont ouverts en même temps
- isitelFacturation Nouveau et l'un des classeurs (1 ou 2 ou 3)
- isitelFacturation Nouveau contient la Feuille "suiviRdV",
- Les classeurs 1,2 et 3 contiennent la Feuille "RendezVous"

Mon seul souci était de pouvoir activer le classeur ouvert non actif contenant la Feuille "RendezVous" (quel que soit le Classeur 1,2 ou 3 ouvert).

Avec Laurent (laurent950), enfin surtout lui, nous avons à force de temps et de messages privés, fini par trouver la solution.

Je tenais à vous remercier tous d'avoir bien voulu m'aider et me consacrer de votre temps.
Surtout que les explications de départ n'étaient certainement pas très claires.

La partie du code qui a permi la solution est :
VB: 
' Cherche le workbook et la worksheet "RendezVous"
      On Error Resume Next
      Set WbP = Application.Parent.Workbooks
      For i = 1 To 2
        Set WsInv = WbP.Item(i).Worksheets("RendezVous")
        If Err = 0 Then
            Set WsInv = WbP.Item(i).Worksheets("RendezVous") ' La Feuille du classeur qui contient la feuille "RendezVous"
                'MsgBox WsInv.Name
            Set WbInv = Workbooks(WbP.Item(i).Name) ' Le classeur qui contient la feuille "RendezVous"
                'MsgBox WbInv.Name
        Exit For
        End If
        Err = 0
      Next i
      On Error GoTo 0
'
    If WsInv Is Nothing Then
        MsgBox "La feuille 'RendezVous' n'a pas été trouvée dans les autres classeurs.", vbExclamation
        Exit Sub
    End If
 
    Sheets("suiviRdV").Select
    'suite de mon long code'
Encore merci à tous et...
un GRAND MERCI à Laurent pour sa ténacité, sa patience, son indulgence face à mes élucubrations lacunaires et pour m'avoir accordé beaucoup de son temps car ce code qui concerne ma facturation est évidemment très important pour moi.
🙂
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
387
farid
F
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
750
jeff1494
C
  • Question Question
XL 2019 Fermeture des nouveaux classeurs excel
Réponses
3
Affichages
603
cd95
C
F
  • Question Question
Microsoft 365 Copier un dossier et son contenu puis y enregistrer un classeur. Renommer chaque élément selon des valeurs de cellules
Réponses
1
Affichages
821
Zon
Z
M
  • Résolu(e)
Microsoft 365 enregistrement copie du classeur ouvert avec mot de passe et incrémentation
2
Réponses
27
Affichages
2 K
meyscal
M
B
  • Question Question
XL 2016 Enregistrer un nouveau classeur dans le même dossier que l'ancien classeur
Réponses
6
Affichages
2 K
BPM
B
  • Question Question
Microsoft 365 exécuter un code uniquement si le classeur est ouvert sur mon ordinateur
2 3
Réponses
32
Affichages
2 K
Tetonne
T
I
  • Question Question
XL 2019 EXCEL 2019 - VBA Export tableau millier de lignes dans classeur chaque 100 lignes
Réponses
3
Affichages
633
iStarsS
I
E
  • Résolu(e)
XL 2013 Création d'un nom de champs de cellules provenant d'un autre classeur ouvert
Réponses
10
Affichages
1 K
ericm1960
E
K
  • Question Question
Microsoft 365 Appliquer un script à tous les classeur ouvert
Réponses
9
Affichages
1 K
Hasco
W
  • Résolu(e)
Microsoft 365 VBA : Déplacer une sélection de feuilles dans un nouveau classeur
Réponses
4
Affichages
3 K
WhatIsVBA
W
A
  • Question Question
XL 2016 Bouton "mettre à jour" depuis classeur externe
Réponses
10
Affichages
2 K
arian
A
S
  • Question Question
XL 2013 [VBA] Modifier valeur dans un autre classeur excel en fonction de valeur
Réponses
0
Affichages
1 K
StagiaiireVannes
S
R
  • Résolu(e)
Autres Copier des feuilles d'un classeur à partir de données identiques
Réponses
2
Affichages
1 K
Renaud22
R
A
  • Question Question
XL 2010 Mise à jour de plusieurs Classeurs Excel xlsx par un classeur xlsm
Réponses
1
Affichages
1 K
_Thierry
R
  • Question Question
XL 2016 Gestion de chemin de fichiers + VBA
Réponses
0
Affichages
3 K
Ryoken
R
C
  • Résolu(e)
XL 2013 VBA - Amélioration d'une macro consolidation
Réponses
8
Affichages
2 K
Genii
G
  • Question Question
XL 2010 RowSource Combobox - Classeur ouvert mais non actif
Réponses
3
Affichages
971
eriiic
S
  • Question Question
XL 2010 Copie de classeur sous un autre nom
Réponses
1
Affichages
697
sams96
S
  • Question Question
[VBA] Compter le nombre de cellules égales à une valeur
Réponses
7
Affichages
13 K
Citronflexe
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…