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

Usine à gaz · 27 Septembre 2023

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.
🙂

Usine à gaz · 27 Septembre 2023

Dranreb à dit:
S'il n'y a que deux classeurs ouverts j'aurais dit

VB:

Dim Wbk As Workbook For Each Wbk In Workbooks If Wbk.Name <> ThisWorkbook.Name Then Exit For Next Wbk … … … ActiveCell.Resize(499, 1) = Wbk.Sheets("RendezVous").Range("L4:L502").Value

Bonjour Dranreb 🙂
Merci beaucoup pour ce code.
Je regarde ce soir 🙂

Dranreb · 27 Septembre 2023

Si seul le classeur à prendre possède une feuille "RendezVous", on peut aussi faire comme ça :

VB:

Sub SiActif()
   Dim Wbk As Workbook, RngSrc As Range
   On Error Resume Next
   For Each Wbk In Workbooks
      Err.Clear: Set RngSrc = Wbk.Worksheets("RendezVous").Range("L4:L502")
      If Err = 0 Then Exit For
      Next Wbk
…
   ActiveCell.Resize(499, 1) = RngSrc.Value

Usine à gaz · 27 Septembre 2023

Dranreb à dit:
S'il n'y a que deux classeurs ouverts j'aurais dit

VB:

Dim Wbk As Workbook For Each Wbk In Workbooks If Wbk.Name <> ThisWorkbook.Name Then Exit For Next Wbk … … … ActiveCell.Resize(499, 1) = Wbk.Sheets("RendezVous").Range("L4:L502").Value

Re-Bjr 🙂

VB:

Sub SiActif()
Application.EnableEvents = False
Application.ScreenUpdating = False
    Dim Wbk As Workbook
    For Each Wbk In Workbooks
    If Wbk.Name <> ThisWorkbook.Name Then Exit For
    Next Wbk
    
    If [ci1] = "" Then 'SI 1er TRAITEMENT
    ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(3).Select
    Else 'SI APRES 1er TRAITEMENT
    ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks(a(i)).Sheets("RendezVous").Range("L4:L502").Value
etc...

Me dit :

🙂

Dranreb · 27 Septembre 2023

Sur quelle instruction ?
Ah, non j'ai vu: vous avez oublié de remplacer Workbooks(a(i)) par Wbk.

Usine à gaz · 27 Septembre 2023

Dranreb à dit:
Sur quelle instruction ?
Ah, non j'ai vu: vous avez oublié de remplacer Workbooks(a(i)) par Wbk.

Rien à faire : ne copie pas 🙂

Dranreb · 27 Septembre 2023

Je n'ai pas assez d'éléments pour pouvoir trouver pourquoi …

job75 · 27 Septembre 2023

Usine à gaz à dit:
Hé ben non, il ne me rapporte rien du tout dans mon classeur actif (isitelFacturation Nouveau) !
Je cherche pourquoi mais je ne trouve pas lol 🙂

Normal, c'est ton code et il n'a rien à voir avec le mien.

Usine à gaz · 27 Septembre 2023

job75 à dit:
Normal, c'est ton code et il n'a rien à voir avec le mien.

Re-Gérard 🙂
Comprends pas, pourtant j'ai copié/coler.
Je reprends ton code du #post 13
🙂

Usine à gaz · 27 Septembre 2023

Re-Gérard 🙂
Je n'y arrive pas Grrr !!!
Tu vourais regarder. Je mets le code complet :

VB:

Sub SiActif()
Application.EnableEvents = False
Application.ScreenUpdating = False
    'Gérard
    Dim a, i
        a = Array("isitelFacturation Nouveau", "isitelImmobRdV ImenNF", "isitelImmobRdV SondaNF", "isitelImmobRdV StephanieNF")
        If Not ActiveWorkbook.Name Like a(0) & ".xl*" Then Exit Sub
        'ActiveCell.Offset(0, 0).Resize(499, 1) = "" 'RAZ
        On Error Resume Next
        For i = 1 To UBound(a)
   
    If [ci1] = "" Then 'SI 1er TRAITEMENT
    ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(3).Select
    Else 'SI APRES 1er TRAITEMENT
    ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks(a(i)).Sheets("RendezVous").Range("L4:L502").Value
   
    If [ci1] = "" Then
    ActiveSheet.Cells(Rows.Count, "b").End(xlUp)(4).Select
    Else
    ActiveSheet.Cells(Rows.Count, "b").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks(a(i)).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(a(i)).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(a(i)).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(a(i)).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(a(i)).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(a(i)).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(a(i)).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(a(i)).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(a(i)).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(a(i)).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(a(i)).Sheets("RendezVous").Range("A4:B502").Value
    Next
'Application.EnableEvents = True
'Application.ScreenUpdating = True
End Sub

Le classeur actil est isitelFacturation Nouveau
Bon sang, pourquoi ça copie pas...

job75 · 27 Septembre 2023

Ton code est une usine à gaz, exécute celui que j'ai donné.

Ne rien y modifier à part l'Array a.

Usine à gaz · 27 Septembre 2023

Mais j'ai besoin de faire toutes ses opérations 😳
Je ne veux embêter personne.
je laisse tomber.
Désolé envers tous pour le temps perdu. je vous prie de m'en excuser 😳

laurent950 · 27 Septembre 2023

Re @Usine à gaz
Tu peux poster ton tous premier code celui que tu avais au moment de la publication de ton poste en #1 sans avoir rien modifié je vais regarder
La solution est peux être pas si compliqué

Usine à gaz · 27 Septembre 2023

laurent950 à dit:
Re @Usine à gaz
Tu peux poster ton tous premier code celui que tu avais au moment de la publication de ton poste en #1 sans avoir rien modifié je vais regarder
La solution est peux être pas si compliqué

Vraiment Laurent, je te remercie 🙂
Mais je ne veux pas que tu perdes trop de temps avec ça..
Le code complet est vraiment long car c'est un gros traitement et comme dirait notre Gérard, celui-là est vraiment une Usine à gaz pour qui le verra.

Si tu veux, tu pourrais reprendre la philosophie du code que j'ai mis au #post 39.
Le principe du code :

VB:

'Gérard
    Dim a, i
        a = Array("isitelFacturation Nouveau", "isitelImmobRdV ImenNF", "isitelImmobRdV SondaNF", "isitelImmobRdV StephanieNF")
        If Not ActiveWorkbook.Name Like a(0) & ".xl*" Then Exit Sub
        'ActiveCell.Offset(0, 0).Resize(499, 1) = "" 'RAZ
        On Error Resume Next
        For i = 1 To UBound(a)

est de Gérard,

Le principe de mes 12 actions est très simple me semble-t-il :
- Le classeur xlsm "isitelFacturation Nouveau" est OUVERT et ACTIF
- l'un des 3 autres classeurs xlsm est OUVERT et NON ACTIF

Par exemple la 1ère action :

Code:

If [ci1] = "" Then 'SI 1er TRAITEMENT
    ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(3).Select
    Else 'SI APRES 1er TRAITEMENT
    ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).Select
    End If
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks(a(i)).Sheets("RendezVous").Range("L4:L502").Value

Sachant que la cellule "ActiveSheet.Cells(Rows.Count, "a").End(xlUp)(2).Select" de mon classeur isitelFacturation Nouveau" OUVERT et ACTIF est sélectionnée

Il doit me copier dans mon classeur "isitelFacturation Nouveau" la valeur des cellules (Workbooks(a(i)).Sheets("RendezVous").Range("L4:L502").Value) du classeur OUVERT et NON ACTIF
et ainsi de suite

Dans un 1er temps, je suis sur une possible autre solution.
Je te dirai 🙂

laurent950 · 27 Septembre 2023

Re @Usine à gaz

regarde cela

VB:

Sub SiActif()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim LastRow As Long
    
    ' Cherche le workbook et la worksheet
    For Each Wb In Workbooks
        If Wb.Name <> ThisWorkbook.Name Then
            Set Ws = Wb.Worksheets("RendezVous")
            Exit For
        End If
    Next Wb
    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

Usine à gaz · 27 Septembre 2023

laurent950 à dit:

Re @Usine à gaz

regarde cela

VB:

Sub SiActif()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
   
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim LastRow As Long
   
    ' Cherche le workbook et la worksheet
    For Each Wb In Workbooks
        If Wb.Name <> ThisWorkbook.Name Then
            Set Ws = Wb.Worksheets("RendezVous")
            Exit For
        End If
    Next Wb
    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

Merci Laurent 🙂
Je regarderai...

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

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Discussions similaires

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

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency