Microsoft 365 Macro entre 2 classeurs

wDog66 à dit:

Bonjour @Nounours4173

Pour commencer, votre code est mal construit 😞

Ensuite, ne serait-il pas possible d'avoir le fichier + un "bus*" pour l'optimiser ?

A+

Cliquez pour agrandir...

fanch55 à dit:

Bonjour à tous,
Si j'ai à peu près compris, classeur à tester, Sub Test à exécuter .
Je m'étonne cependant que votre macro ne précise pas les feuilles des Classeurs.
Ne les connaissant pas, J'ai laissé tel quel ...

Cliquez pour agrandir...

TooFatBoy à dit:

Bonjour,

Est-ce que c'est une question vraiment différente de l'autre fil de discussion ?

Cliquez pour agrandir...

Nounours4173 à dit:

La macro "envois donnée bilan " me permet de copier les données présentes en L22 : P30 dans un autre classeur excel.

Cliquez pour agrandir...

fanch55 à dit:

La macro n'est pas présente dans le classeur fourni ...
Je suppose qu'elle a été remplacée par le code proposé ?

Cliquez pour agrandir...

fanch55 à dit:

Testez le classeur joint ( je l'ai zippé avec un fichier cible exemple )

Cliquez pour agrandir...

Sub Envois_Données_Bilan()
Dim Target_Actif As Boolean
Dim Target_Name  As String

    ' On détermine le fichier cible
    Target_Name = "G:\Mon Drive\Ete 2025\Bus\Bus Bilan 2025.xlsx"
    
    ' On regarde si la cible est déjà active
    Dim Wn As Variant
    For Each Wn In Windows
        If Wn.Caption = Target_Name Then
            Target_Actif = True
            Exit For
        End If
    Next
    
    ' la cible n'est pas active,
    ' si elle existe dans le dossier de ce classeur, on l'ouvre
    If Not Target_Actif Then
        Dim Fso:  Set Fso = CreateObject("Scripting.FileSystemObject")
        Dim Fname As String: Fname = ThisWorkbook.Path & "\" & Target_Name
        If Fso.FileExists(Fname) Then
            Workbooks.Open Fname
            Target_Actif = True
        End If
    End If
    
    ' la cible n'est toujours pas active,
    ' on demande la cible à ouvrir
    If Not Target_Actif Then
        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = False
            .InitialFileName = Fname
            If .Show Then
                Workbooks.Open .SelectedItems(1)
                Target_Name = ActiveWindow.Caption
                Target_Actif = True
            End If
        End With
    End If
    
   ' La cible est active, on peut copier
    If Target_Actif Then
        Dim I As Integer
        Dim Plage As Range: Set Plage = ThisWorkbook.ActiveSheet.Range("L22:P30")
        With ThisWorkbook.ActiveSheet.Outline
            .ShowLevels RowLevels:=0, ColumnLevels:=1
            .ShowLevels RowLevels:=0, ColumnLevels:=2
            .ShowLevels RowLevels:=1
            .ShowLevels RowLevels:=2
        End With
        With Windows(Target_Name).Activate
            For I = 1 To Plage.Rows.Count
                Range("A2").ListObject.ListRows.Add I
            Next
            Plage.Copy
            Range("A2").PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        ThisWorkbook.Activate
    End If
    
    
End Sub

fanch55 à dit:

Le Classeur fourni ( Bus Anonyme ) représente lequel ?
le Bus bilan ou le Bus journalier ?

Cliquez pour agrandir...

fanch55 à dit:

Finalement, pour ne pas multiplier inutilement la macro,
elle ne devrait être que dans le Classeur Bilan où il devrait y avoir un bouton pour importer les données .
Etes-vous d'accord ?

Cliquez pour agrandir...