Copier coller entre deux classeurs

Bonjour à tous,

je sollicite votre aide afin de créer une macro qui fais les instructions suivantes :

la macros doit se trouver dans le classeur TRVX EN COURS

On m'a déjà fait cette macro, mais elle se trouve dans le classeur préventifs programmés

Je vous ai laissé les deux classeurs en pièce jointe.

merci a tous,

Bonjour, voilà le code pour importer les données d'un classeur à un autre. En espérant répondre à ton besoin. Peux-tu en dire plus sur les condition de filtre, que je les intègres au code d'importation.

Sub Impor()
Dim Wb As Workbook
Dim Ws As Worksheet, FeuilleAccueil As Worksheet
Dim Wb_URL As String, Wb_Nom As String, PremCol As String, DernCol As String
Dim PremLig As Long, Dernlig As Long
Dim Datas() As Variant

    Wb_Nom = "maintenance-preventive-program v1.xlsm" 'A ajuster
    Wb_URL = "C:\DataBusiness\lemargaut1\Desktop\tempo\nouveau-dossier-compresse-1\" 'A ajuster
    Set Wb = Application.Workbooks.Open(Wb_URL & Wb_Nom, ReadOnly:=True)
    Set Ws = Wb.Worksheets("PROGRAMME GLOBAL") 'A ajuster
    PremCol = "B": DernCol = "L"
    PremLig = 4: Dernlig = Ws.Range(PremCol & Ws.Rows.Count).End(xlUp).Row
    Datas = Ws.Range(PremCol & PremLig & ":" & DernCol & Dernlig).Value
    Wb.Close False
    Set FeuilleAccueil = ThisWorkbook.Worksheets("TRVX EN COURS") 'A ajuster
    Dernlig = FeuilleAccueil.Range(PremCol & FeuilleAccueil.Rows.Count).End(xlUp).Row + 1
    FeuilleAccueil.Range("F" & Dernlig).Resize(UBound(Datas, 1), UBound(Datas, 2)) = Datas
End Sub

Voilà quelque chose de plus complet (avec filtre des préventifs du mois en cours) : tu trouveras l'adaption dans le fichier joint

Option Explicit

Sub Impor()
Dim Wb As Workbook
Dim Ws As Worksheet, FeuilleAccueil As Worksheet
Dim Wb_URL As String, Wb_Nom As String, PremCol As String, DernCol As String, List As String
Dim PremLig As Long, Dernlig As Long, i As Long, j As Long
Dim Datas() As Variant, TBL() As Variant
Dim Wb_Open As Boolean

    On Error GoTo ErrImport
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Wb_Nom = "maintenance-preventive-program v1.xlsm" 'A ajuster
    Wb_Open = False
    For i = 1 To Application.Windows.Count 'Vérification si fichier déjà ouvert
        If Application.Windows(i).Caption = Wb_Nom Then Wb_Open = True
    Next i
    If Wb_Open = True Then 'Si fichier déjà ouvert
        Set Wb = Application.Workbooks(Wb_Nom)
    Else 'Si fichier pas ouvert
        Wb_URL = "C:\DataBusiness\lemargaut1\Desktop\tempo\nouveau-dossier-compresse-1\" 'A ajuster
        Set Wb = Application.Workbooks.Open(Wb_URL & Wb_Nom, ReadOnly:=True) 'Ouverture en lecture seul
        Application.Windows(Wb.Name).Visible = False
    End If
    Set Ws = Wb.Worksheets("PROGRAMME GLOBAL") 'A ajuster (feuille où lire les préventis)
    PremCol = "B": DernCol = "L" 'Limite de colonnes de lecture
    PremLig = 4: Dernlig = Ws.Range(PremCol & Ws.Rows.Count).End(xlUp).Row 'Limite de lignes de lecture
    Datas = Ws.Range(PremCol & PremLig & ":" & DernCol & Dernlig).Value 'Définition de la plage de données à lire
    List = ""
    For i = LBound(Datas) To UBound(Datas) 'Récupération des n° de lignes correspondantes au mois en cours
        If Month(Datas(i, 7)) = Month(Now) Then If List = "" Then List = i Else List = List & "-" & i
    Next i
    If List = "" Then MsgBox "Pas de préventif", vbExclamation: Exit Sub
    ReDim TBL(1 To UBound(Split(List, "-")) + 1, LBound(Datas) To UBound(Datas, 2)) 'Création du tableau pour récupération des préventis
    For i = LBound(TBL) To UBound(TBL, 1) 'Ecriture des préventifs dans le tableau en fonction des n° de lignes précédemment recupérées
        For j = LBound(TBL) To UBound(TBL, 2)
            TBL(i, j) = Datas(Split(List, "-")(i - 1), j)
        Next j
    Next i
    If Wb_Open = False Then Wb.Close False 'Si c'est le programme qui a ouvert le fichier il le ferme sinon il le laisse ouvert
    Set FeuilleAccueil = ThisWorkbook.Worksheets("TRVX EN COURS") 'A ajuster
    Dernlig = FeuilleAccueil.Range(PremCol & FeuilleAccueil.Rows.Count).End(xlUp).Row + 1
    FeuilleAccueil.Range("F" & Dernlig).Resize(UBound(TBL, 1), UBound(TBL, 2)) = Datas 'Ecriture du tableau de préventif dans la feuille adequate du classeur
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationSemiautomatic
    MsgBox "Importation terminée, " & UBound(Split(List, "-")) + 1 & " préventif(s) importé(s).", vbInformation
    Exit Sub

ErrImport:
    MsgBox "Une erreure critique est survenue pendant l'importation.", vbCritical
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub