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

Usine à gaz

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
Dranreb

Dranreb

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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
Cliquez pour agrandir...
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 :
1695824197572.png

:)
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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...
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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é
Cliquez pour agrandir...
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 :)
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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
Cliquez pour agrandir...
Merci Laurent :)
Je regarderai...
 
Vote positif 0 Vote négatif

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
100
farid
F
C
  • Question
XL 2019 Coller valeur dans autre classeur
Réponses
14
Affichages
375
carlos
C
T
  • Question
Microsoft 365 Import de données et liaisons entre classeurs
Réponses
14
Affichages
551
TCHIS
T
Electron24
  • Résolu(e)
Microsoft 365 Save qu'une feuille d'un classeur
Réponses
4
Affichages
516
Electron24
Electron24
C
  • Question
XL 2019 Fermeture des nouveaux classeurs excel
Réponses
3
Affichages
470
cd95
C
F
  • 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
480
Zon
Z
Usine à gaz
  • Résolu(e)
XL 2021 enregistrer à la fermeture au clic sur la "X" mon classeur à son emplacement (d'où il a été ouvert)
Réponses
14
Affichages
651
Usine à gaz
Usine à gaz
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
536
sousou
sousou
M
  • Résolu(e)
Microsoft 365 enregistrement copie du classeur ouvert avec mot de passe et incrémentation
2
Réponses
27
Affichages
915
meyscal
M
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
838
Dranreb
Dranreb

Membres actuellement en ligne

16 membres et 147 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 213
Messages
2 086 302
Membres
103 174
dernier inscrit
OBUTT