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

[Usine à gaz]

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]

Bonjour Lionel, le forum,

Une solution très simple :

Sub Test()
Dim a, i
a = Array("isitelFacturation Nouveau", "Classeur1", "Classeur2", "Classeur3")
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)
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks(a(i)).Sheets("RendezVous").Range("L4:L502").Value
Next
End Sub

A+

Bonjour et merci Gérard
Je vais regarder

 

[job75]

ActiveCell.Offset(0, 0) c'est absurde

Bah il est évident que Lionel veut pouvoir remplacer les zéros par d'autres nombres.

 

[dysorthographie]

ActiveCell

 

[Usine à gaz]

ActiveCell

Yes lol

 

[dysorthographie]

Bah il est évident que Lionel veut pouvoir remplacer les zéros par d'autres nombres.

De toutes évidence ça n'a pas l'air si évident

 

[Usine à gaz]

De toutes évidence ça n'a pas l'air si évident

Faudra que je détaille pourquoi pour moi c'est important pas pas inutile.
Je fais ça dès que je peux... certainement ce soir

 

[dysorthographie]

Quelle classeur execute la macro (sachant que le classeur actif est toujours : isitelFacturation Nouveau?

 

[dysorthographie]

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)), ActiveCell: 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 Range)
 'Traitement
 Cible.Resize(499, 1) = Source.Sheets("RendezVous").Range("L4:L500").Value
End Sub

 

[laurent950]

Bonjour @uzineagaz

Une question, lorsque tu as excel d'ouvert, c'est à dire l'application tu as 2 classeurs qui sont ouvert et pas plus lorsque tu excecutes le code ?
Il n'y a pas d'autres classeur ouvert qui n'ont rien à voir avec le code ?
Donc 2 classeurs ouvert avec l'application = oui
Ou plusieurs classeurs ouvert = Non ?

 

[Usine à gaz]

Bonjour Lionel, le forum,

Une solution très simple :

Sub Test()
Dim a, i
a = Array("isitelFacturation Nouveau", "Classeur1", "Classeur2", "Classeur3")
If Not ActiveWorkbook.Name Like a(0) & ".xl*" Then Exit Sub
ActiveCell.Offset(0, 0).Resize(499, 1) = "" 'RAZ - lol faut pas qu'il n'efface mes cellules
On Error Resume Next
For i = 1 To UBound(a)
    ActiveCell.Offset(0, 0).Resize(499, 1) = Workbooks(a(i)).Sheets("RendezVous").Range("L4:L502").Value
Next
End Sub

A+

Re-Bjr Gérard
Bon sang, je ne m'en sors pas Grrr !!!

J'ai étudié la solution de sylvanu = pas moyen de la faire fonctionner.

Je suis sur ton code = pas moyen non plus, me suis-je trompé en prenant ton code :

Sub SiActif()
Application.EnableEvents = False
Application.ScreenUpdating = False
    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)
    Next
 
    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...

Normalement, il doit me copier les valeurs des cellules "L4:L502" du fichier ouvert NON actif.
Pour info, les cellules "L4:L502" contiennent des chiffres (n° des clients)
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

 

[Usine à gaz]

Bonjour @uzineagaz

Une question, lorsque tu as excel d'ouvert, c'est à dire l'application tu as 2 classeurs qui sont ouvert et pas plus lorsque tu excecutes le code ?
Il n'y a pas d'autres classeur ouvert qui n'ont rien à voir avec le code ?
Donc 2 classeurs ouvert avec l'application = oui
Ou plusieurs classeurs ouvert = Non ?

Bjr à toi
OUI : uniquement 2 classeurs

 

[laurent950]

Ré Lionel

```vba
Sub test()
Dim wkbP As Workbook
Dim wkb As Workbook
Set wkbP = ThisWorkbook
For Each wkb In Application.Workbooks
If wkb.Name <> wkbP.Name Then
' Vous avez trouvé le classeur !
Set wkb = Worksheets(wkb)
Exit For
End If
Next wkb
MsgBox wkb.Name
Suite de ton code
End Sub

Cela devrait être ok

 

[Dranreb]

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

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

 

[laurent950]

Bonjour @Dranreb

Excelent vous êtes super fort merci votre code 10/10

Laurent

 

[Usine à gaz]

Ré Lionel

```vba
Sub test()
Dim wkbP As Workbook
Dim wkb As Workbook
Set wkbP = ThisWorkbook
For Each wkb In Application.Workbooks
If wkb.Name <> wkbP.Name Then
' Vous avez trouvé le classeur !
Set wkb = Worksheets(wkb)
Exit For
End If
Next wkb
MsgBox wkb.Name
Suite de ton code
End Sub

Cela devrait être ok

Merci Laurent, je vais regarder ce soir