Bouton macro copie colle données d'un classeur à un autre

Bonjour à tous,

j'ai un classseur nommé "Add copie colle" dans lequel j'ai 3 feuilles :

  • Feuille ADV (qui affiche les données d'un classeur de ADV, il y integre les nouveaux code article ,qté date de livraison).
  • Feuille Planning (avec sur laquelle je bosse tout les jours qui est plus complet que celui de ADV)
  • Feuille Données-ERP (qui est relié a mon ERP pour avoir plusieurs données)
Le but est créer un bouton dans la feuille ADV (un bouton ajouter)

Exemple :

lorsque je clic sur le bouton "+" situé en case A9 alors je copie uniquement les valeurs qui m'intéressent à savoir :

le code article, la Matière, la qté et la date de livraison dans les cellule respective dans ma feuille Planning.

J'ai enregistrer une macro qui me donne un peu ce que je veux faire à savoir:

Sub Macro1()
'
' Macro1 Macro
'

    Sheets("ADV").Select
    Range("B2").Select
    Selection.Copy
    Sheets("Planning").Select
    Range("A3").Select
    ActiveSheet.Paste
    Sheets("ADV").Select
    Range("E2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Planning").Select
    Range("F3").Select
    ActiveSheet.Paste
    Sheets("ADV").Select
    Range("F2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Planning").Select
    Range("E3").Select
    ActiveSheet.Paste
    Sheets("ADV").Select
    Range("G2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Planning").Select
    Range("H3").Select
    ActiveSheet.Paste

End Sub

Merci d'avance pour vos suggestions.

J'avance mais ça ne marche pas encore

'Macro Transfert ligne de commande ADV vers Planning
Sub Transfert_ADV_PlanningProg()
Dim LastLig As Long
Dim sDest As Worksheet ' Feuille de destination
Dim cDest As Range ' Cellule de destination
Dim lCount As Long ' Nombre de cellule copié
Dim lFirst As Long ' Premiere cellule de date
'boite de dialogue pour confirmer l'archivage
If MsgBox("Transfert des commandes vers planning Programmation", vbYesNo + vbExclamation + vbDefaultButton2, "Mail") = vbYes Then
 Application.ScreenUpdating = False
With ThisWorkbook
    'cDest: La celllule de destination: première cellule vide de la colonne A de Feuille planning
    Set sDest = .Worksheets("Planning")
    Set cDest = sDest.Cells(sDest.Rows.Count, "A").End(xlUp)(2)

    With .Worksheets("ADV")
        'Enlève l'éventuel filtre automatique
        '.AutoFilterMode = True
        'LastLig, ligne de la dernière cellule remplie de colonne A de Planning
        LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
        'On fait un filtre automatique sur la colonne I de ADV avec comme critère "Non traité"
        .Range("H1:H" & LastLig).AutoFilter Field:=8, Criteria1:= _
        "Non traité"
        'Si au moins une ligne résultat du filtre (en plus de la ligne 1 des titres)
        lCount = .Range("I1:I" & LastLig).SpecialCells(xlCellTypeVisible).Count
        If lCount > 1 Then
            With .Range("I2:I" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow
              'On copie toutes les lignes visibles vers cDest (sauf la ligne des titres)
                .Copy cDest

            End With
            'cDest.ClearComments

            ' On récupère la première cellule de la copie
            lFirst = cDest.Rows(0).Row
            ' On écrit la date dans la plage définie
            sDest.Range(sDest.Cells(lFirst, "A"), sDest.Cells(lFirst + (lCount - 1), "A")).Value =
            sDest.Range(sDest.Cells(lFirst, "E"), sDest.Cells(lFirst + (lCount - 1), "E")).Value = 
            sDest.Range(sDest.Cells(lFirst, "F"), sDest.Cells(lFirst + (lCount - 1), "F")).Value = 
            sDest.Range(sDest.Cells(lFirst, "K"), sDest.Cells(lFirst + (lCount - 1), "K")).Value = 

        End If
        'on vide notre variable cDest
        Set cDest = Nothing
        'On enlève le filtre automatique
        .AutoFilterMode = False
    End With
End With
'Sheets("Archivage").Se
    ' Ne fonctionne pas en classeur partagé
    'Cells.FormatConditions.Delete
    'Columns("A:A").Select

    'Actualisation du graphique OF sortie
    'Sheets("Courbe objectif prog.").Select
    'Range("E23").Select
    ' Actualisation du graphique ne fonctionne pas en classeur partagé
    'ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh

    'Sheets("Planning").Select
    End If
    ' Active_flitre Macro

    'Range("I2").Select
    'Selection.AutoFilter
End Sub
Rechercher des sujets similaires à "bouton macro copie colle donnees classeur"