Incrementer une feuille dans un autre classeur VBA

Question

Bonjour à toutes & tous

Tout jeune dans l'histoire du VBA, je suis à la recherche de lignes de codes pour la réalisation suivante :

Dans un classeur, j'ai une feuille Excel dites "Litige", qui me sert de matrice, j'en souhaite récupérer plusieurs cellules différentes pour les copier dans un autre classeur et feuille dites "suivi" + dans des cellules bien distinctes.

Mon souci, c'est que lorsque je change les données de ma matrice "litige" et que je clique sur le bouton "Ajout", les nouvelles cellules copiées se mettent sur la ligne n°2 mais la référence des cellules est décalée de 1.

La première fois est bon, mais quand j'en fait un deuxième que cela ne va plus.

J'ai trouvé des lignes de codes mais cela se fait par ligne et quand je fais un rajout, les cellules sont décalées de 1...

Si vous avez des idées, je suis preneur ! et j'espère avoir été clair..

Merci

Private Sub CommandButton1_Click()

Dim Last_Row1 As Long, Last_Row2 As Long
Dim WB1 As Workbook, WB2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet

Set WB1 = ThisWorkbook
Set ws1 = WB1.Sheets("Suivi")
Set WB2 = Workbooks.Open("C:\Users\xxxxx\Desktop\Test macro.xlsx")
Set ws2 = WB2.Sheets("Feuil1")

Last_Row1 = ws1.Range("B" & Rows.Count).End(xlUp).Row
Last_Row2 = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1

ws1.Range("A2:J" & Last_Row1).Copy ws2.Range("A" & Last_Row2)

End Sub

9matrice-litige-papier-test-copie-copie.xlsm (47.99 Ko)

AlgoPlus · Accepted Answer

A finir de modifier Sub ajout() DL = Worksheets("suivi").Range("B" & Rows.Count).End(xlUp).Row + 1 Worksheets("suivi").Range("B" & DL).Value = Worksheets("litige").Range("B6").Value Worksheets("suivi").Range("C" & DL).Value = Worksheets("litige").Range("B8").Value .../... Worksheets("suivi").Range("G" & DL).Value = Worksheets("litige").Range("C40:C48").Value End Sub Pour la dernière ligne de copie , je ne sais pas ce que vous attendez comme résultat......

ThauThème · Answer

Bonsoir Sa, bonsoir le forum,

Ton code plante d'entrée car il y a des erreurs :

Private Sub CommandButton1_Click()

Dim Last_Row1 As Long, Last_Row2 As Long
Dim WB1 As Workbook, WB2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet

Set WB1 = ThisWorkbook
Set ws1 = WB1.Sheets("Litige") 'au lieu de "suivi" <=== ici 
Set WB2 = Workbooks.Open("C:\Users\xxxxx\Desktop\Test macro.xlsx")
Set ws2 = WB2.Sheets("suivi") 'au lieu de "Feuil1" <=== ici
Last_Row1 = ws1.Range("B" & Rows.Count).End(xlUp).Row ' toujours la ligne ligne 55 c'est OK ?
Last_Row2 = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 'première ligne vide de la colonne A c'est OK
ws1.Range("A2:J" & Last_Row1).Copy ws2.Range("A" & Last_Row2)
End Sub

AlgoPlus · Answer

Pas compris les explications par rapport au classeur et au code présenté... Dans le code : aucun accès à la feuille "Litige" Dans le code on copie des données de la feuille "Suivi" vers un autre classeur ( et la copie fonctionne bien) Dans le classeur il n'y a pas de feuille "Suivi" A+...

AlgoPlus · Answer

C'est bien ce que fait le code... sauf si dans la feuille où on veut copier, la dernière ligne contenant une donnée de la colonne A n'est pas la dernière ligne de la plage. Mais sans le bon classeur, impossible d'être sûr... A+ et bonjour ThauThème...

AlgoPlus · Answer

Finalement le code proposé n'a rien à voir avec le besoin ? ( ou alors de très loin ou je n'ai rien compris)

Il faudrait préciser quelles cellules jaunes de la feuille Litige vont dans quelles cellules de la feuille Suivi et notamment s'il y a plusieurs données sur les lignes 39 à 48 de la feuille Litige . ce nombre de lignes restera fixe ou risque-t-il d'augmenter ?