Copier données dans une autre classeur, en fin de liste

Bonjour à tous !

Je dois réaliser une macro permettant de copier des données d'un classeur source vers un autre classeur cible.

Comme je suis une bille en VBA je sollicite le forum pour esperer trouver une solution

Les données à copier sont disséminer un peut partout dans le classeur source:

- Cellule P4 feuille "Synthèse"

- Cellule A1 et A2 feuille "Grille"

- Colonne B,D,E,F feuille "Grille"

Le gros soucis est qu'il peux y avoir des trous dans les colonnes et je ne veux pas copier ces trous. (Ex: L8,L9,L10;L12,L13,L14,L15,...)

De meme dans le fichier cible, il peux y avoir des ligne vides (Ex: L3, L6) ; et je voudrai copier les données tout en bas de la feuille.

Vous trouverez en PJ les deux classeurs. Dans le classeur cible, j'ai mis en orange le resultat attendu.

J'espere etre clair dans mes explications

A bientot

Théophile

bonjour Théophile,

Comme on dit :

C'est en forgeant qu'on devient forgeron

Pourquoi ne pas utiliser l'enregistreur de macro en réalisant les actions que tu souhaites développer en VBA et revenir vers nous avec un début de code ?

a très vite

Bonjour,

J'ai trouvé une solution alternative.

Sub Macro1()
'
' Macro1 Macro
'
' Touche de raccourci du clavier: Ctrl+a
'
    Workbooks.Open "C:\Users\carpentiert\Desktop\test2\Classeur cible.xlsm"
    For x = 1 To 33
        Rows("2:2").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    Next x
' copier coller observation
    Windows("Classeur source.xlsm").Activate
    Range("B4:B36").Select
    Selection.Copy
    Windows("Classeur cible.xlsm").Activate
    Range("C2").Select
    ActiveSheet.Paste

' copier coller amélioration
    Windows("Classeur source.xlsm").Activate
    Range("D4:D36").Select
    Selection.Copy
    Windows("Classeur cible.xlsm").Activate
    Range("L2").Select
    ActiveSheet.Paste

' copier coller echeance
    Windows("Classeur source.xlsm").Activate
    Range("F4:F36").Select
    Selection.Copy
    Windows("Classeur cible.xlsm").Activate
    Range("M2").Select
    ActiveSheet.Paste

' copier coller responsable
    Windows("Classeur source.xlsm").Activate
    Range("E4:E36").Select
    Selection.Copy
    Windows("Classeur cible.xlsm").Activate
    Range("N2").Select
    ActiveSheet.Paste

' Ajout ref audit + date
    Windows("Classeur cible.xlsm").Activate
    Range("A2").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCAT('[Classeur source.xlsm]Grille'!R1C1:R1C6,"" - "",'[Classeur source.xlsm]Grille'!R2C1:R2C6)"
    Windows("Classeur cible.xlsm").Activate
    Range("B2").Select
    ActiveCell.Formula2R1C1 = "='[Classeur source.xlsm]Synthèse'!R4C16"

' Suppression liste données
    Windows("Classeur cible.xlsm").Activate
    Range("D2:K34,O2:P34").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
'Ajout source + norme + chapitre + ecart + secteur + statut
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Audit produit"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "IATF"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "9.2.2.4 Audit produit"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "point d'amélioration"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "Fonderie"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "A définir"

    Range("A2:B2").Select
    Selection.AutoFill Destination:=Range("A2:B34"), Type:=xlFillDefault
    Range("D2:K2").Select
    Selection.AutoFill Destination:=Range("D2:K34"), Type:=xlFillDefault
    Range("O2").Select
    Selection.AutoFill Destination:=Range("O2:O34"), Type:=xlFillDefault

' Supprimer ligne vide
    Windows("Classeur cible.xlsm").Activate
    Range("L2:L34").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A1").Select

End Sub

J'ai en effet utilisé l'enregistreur de macro.