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.

 

[patricktoulon]

bonjour à tous
juste en passant ,je reviens sur le truc là

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

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

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

 

[Usine à gaz]

Re @Usine à gaz

regarde cela

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

Désolé ça beug.
Laisse pour l'instant, je suis sur une autre piste

 

[dysorthographie]

j'ai bien compris que mes proposition sont hors sujet mais naïvement je persiste

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

 

[Usine à gaz]

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

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

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

 

[Usine à gaz]

j'ai bien compris que mes proposition sont hors sujet mais naïvement je persiste

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")
        If CStr(.Cells("ci1")) = "" Then  'SI 1er TRAITEMENT
            .Cells(Rows.Count, "a").End(xlUp).Offset(3).Resize(499, 1) = Source.Sheets("RendezVous").Range("L4:L502").Value
            .Cells(Rows.Count, "b").End(xlUp).Offset(4).Resize(499, 1) = Source.Sheets("RendezVous").Range("Q4:Q502").Value
        Else 'SI APRES 1er TRAITEMENT
            .Cells(Rows.Count, "a").End(xlUp).Offset(2).Resize(499, 1) = Source.Sheets("RendezVous").Range("L4:L502").Value
            .Cells(Rows.Count, "b").End(xlUp).Offset(2).Resize(499, 1) = Source.Sheets("RendezVous").Range("L4:L502").Value
        End If
    End With
End Sub

Sincèrement, je te remercie pour ta gentille et constructive insistance
Je vais tester

 

[Usine à gaz]

j'ai bien compris que mes proposition sont hors sujet mais naïvement je persiste

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

lol : c'est qui TOTO ?

Sincèrement, je te remercie pour ta gentille et constructive insistance
Je vais tester

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

 

[dysorthographie]

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

 

[Usine à gaz]

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 :

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

 

[dysorthographie]

Je comprends pourquoi tes demandes font 50 pages

 

[laurent950]

Re @Usine à gaz

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

 

[Usine à gaz]

Re @Usine à gaz

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.Parent.Worbooks.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

Merci Laurent
Je n'en peux plus.
S'il me reste des forces, je teste ce soir

 

[patricktoulon]

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

re
oui je suis sur ,car apres le next le WBK2 c'est le bon classeur si il est ouvert bien sur

 

[Usine à gaz]

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 :

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

 

[Dranreb]

Bonjour/
Pourquoi n'avoir pas écrit le début simplement comme ça ?

      On Error Resume Next
      For Each Wbk In Workbooks
         Set WsInv = Wbk.Worksheets("RendezVous")
         If Err = 0 Then Exit For
         Err.Clear: Next Wbk
      On Error GoTo 0

 

[Usine à gaz]

Bonjour/
Pourquoi n'avoir pas écrit le début simplement comme ça ?

      On Error Resume Next
      For Each Wbk In Workbooks
         Set WsInv = Wbk.Worksheets("RendezVous")
         If Err = 0 Then Exit For
         Err.Clear: Next Wbk
      On Error GoTo 0

Bjr Dranreb
lol vu mon niveau, je sais pas mais je testerai...
Je te remercie