XL 2010 Coller données dans classeur précédemment créé

[Gasve]

Bonjour à tous,

Je n'ai pas touché à VBA depuis mois, et mes cours n'ont jamais été très profond en la matière. Je me permets donc de solliciter votre aide au travers de ce forum.

Il m'est demandé de copier/coller les valeurs, d'une plage variable, dans un nouveau classeur en y insérant une nouvelle colonne dans laquelle se trouvera un nombre de caractère précis, présent dans le titre du fichier source.
Jusqu'ici j'ai réussi à élaborer (en fouillant dans une multitude de forums) un code qui me permet d'obtenir cela. Je vous fais parvenir le code :

Sub Createwrkb()

Dim source As Workbook
Dim destination As Workbook
Dim LongLigne As Long

Set source = ThisWorkbook

ActiveSheet.Range("A6:K6").Copy 'copie la ligne 6 du fichier source

Set destination = Workbooks.Add 'création du nouveau classeur
  
ActiveSheet.Paste 'colle les données sur le nouveau classeur
ActiveSheet.Columns.AutoFit 'ajustement de la largeur des colonnes

    With source.Worksheets(1)
        .Range("A8:K65536").Copy destination.Sheets(1).Range("A2") 'les données apparaissent en valeur dans le nouveau classeur
    End With
   
    With destination.Worksheets(1)
        .Columns(1).Insert 'insertion de la nouvelle colonne
    End With

LongLigne = 2
Do While Range("B" & LongLigne).Value <> ""
    LongLigne = LongLigne + 1
Loop
    LongLigne = LongLigne - 1
   
destination.Sheets(1).Range("A2:A" & LongLigne) = Mid(source.Name, 10, 3) 'insertion du numéro d'entité dans la première colonne

End Sub

Mon problème est le suivant : J'aimerai, depuis un autre fichier source copier/coller les valeurs dans le même fichier de destination, tout simplement à la suite. Imaginons que mon premier copier/coller s'arrête à la ligne 416 dans le fichier destination, et bien la nouvelle action copier/coller d'un autre fichier source reprendrai à la suite, ligne 417...

J'espère que j'ai réussi à me faire comprendre. Si cela n'est pas le cas n'hésitez pas à me demander d'avantage de précision.

Je vous remercie d'avance,

 

[Lone-wolf]

Bonjour Gasve et bienvenue sur XLD

Pour copier à la suite

Dim derL As Long, plage As Range

With source.Worksheets(1)
derL = .Range("a" & Rows.Count).End(xlUp).Row

Set plage = .Range("A8:K" & derL)
plage.Copy destination.Sheets(1).Range("a" & Rows.Count).End(xlUp)(2)
End With

 

[Gasve]

Bonjour Lone-wolf et merci de la rapidité de ta réponse.

Je vais essayer d'appliquer ta formule à un autre classeur afin qu'il soit copié sur le classeur de destination.

Je reviendrais sur ce topic si je ne trouve pas mon bonheur !

Encore merci !

 

[Lone-wolf]

Re

Il y a juste une problème. Si à chaque fois tu crée un nouveau classeur, la méthode que je t'ai montré est obsolète.

Si par contre tu copie à la suite dans le même classeur; crée un nouveau classeur manuellement. Ensuite

Sub Copier()
Dim fichier$, Wks As Workbook, ShD As Worksheet
Dim Twb As WorkBook, Sh As Worsheet, DerL&

    'Chemin du classeur à ouvrir et coller les données
    'Si Les deux classeur sont dans le même dossier
    Fichier = ThisWorkbook.Path & "\WbDestination.xlsx"

   'Sinon: fichier = "C:\Toto\Titi\WbDestination.xlsx" à changer avec le vrai chemin
    Set Wks = Workbooks.Open(Fichier)

    Windows("WbDestination").Visible = False

    Set ShD = Wks.Sheets("Feuil1")
   
    'C'est le classeur source et sa feuille
    Set Twb = ThisWorkbook
    Set Sh =  Twb.Sheets(1)

    With Sh
        DerL = .Range("a" & Rows.Count).End(xlUp).Row

         Set plage = .Range("A8:K" & DerL)
         plage.Copy ShD.Sheets(1).Range("a" & Rows.Count).End(xlUp)(2)
    End With
        'Fermeture du classeur source et sauvegarde des données
        Wks.Close True
End Sub

 

[Gasve]

Rebonjour Lone-wolf,

J'ai recopié et adapté le code fournis dans ton premier message, dans le second classeur pour ainsi copier les données dans le même classeur de destination (et à la suite) que le premier source et cela fonctionne.

Je te montre ainsi le code du deuxième classeur :

Sub classeur_suivant()
Dim derL As Long, plage As Range
Dim LongLigne As Long

Set source = ThisWorkbook
Set destination = Workbooks("Strategic Adjustment Summary")

With source.Worksheets(1)
derL = .Range("a" & Rows.Count).End(xlUp).Row

Set plage = .Range("A8:K" & derL)
plage.Copy destination.Sheets(1).Range("B" & Rows.Count).End(xlUp)(2)
End With

LongLigne = 2
Do While Range("B" & LongLigne).Value <> ""
    LongLigne = LongLigne + 1
Loop
    LongLigne = LongLigne - 1
destination.Sheets(1).Range("A" & LongLigne).End(xlUp)(2) = Mid(source.Name, 10, 3)


End Sub

Strategic Adjustment Summary étant le classeur qui a été créé par la macro du premier classeur source.