Macro boucle copier-coller avec lignes variables

Bonjour à tous,

Je suis plutôt novice en programmation VBA, j'aurais donc besoin d'un petit peu d'aide de votre part. Je vous explique ma problématique. Dans mon fichier excel il y a 5 onglets :

  • Bulletin d'inscription 1
  • Résultats BI 1
  • Bulletin d'inscription 2
  • Résultats BI 2
  • Résumé BI

Dans mes bulletins d'inscription j'ai fait une macro qui me permet de copier coller des cellules pour les mettre dans résultats BI, chaque bulletin à donc sa feuille "résultats". J'aimerai pouvoir rassembler les données des 2 feuilles résultats dans résumé BI.

Remarque : le nombre de lignes remplies dépend du nombre d'inscriptions donc il peut être variable. Il faudrait copier coller les données de résultats BI 1 dans résumé BI ; et coller à la suite les données de résultats BI 2 dans résumé BI sans laisser de lignes blanches entre les 2 tableaux résultats ; il faut donc que ma macro s'adapte à la variation du nombre de lignes du premier tableau.

J'ai regardé énormément de forums, de cours mais impossible de la faire fonctionner. Je suis déjà bloqué à la boucle de copier coller Résultats BI 1 dans résumé BI.

Voici le code que j'utilise pour la première boucle de copier coller de Résultats BI 1 dans résumé BI (qui ne fonctionne déjà pas):

" Sub Ajoutfinal_Cliquer()

Sheets("Resultats BI 1").Select

Dim NbLignes As Integer, i As Integer

NbLignes = Range("E10").Value

For i = 1 To NbLignes Step 1

Sheets("Resultats BI 1").Select

Range("A2:H2").Select

Selection.Copy

Sheets("Résumé BI").Select

Range("A2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Next i

End Sub "

Vous trouverez ci joint mon fichier excel.

Merci d'avance pour votre aide

25projet-info.xlsm (57.75 Ko)

Bonjour,

voici un exemple à tester,

Sub test()
Dim sh1 As Worksheet, sh2 As Worksheet, Lastrow As Long, addr As String
Set sh1 = Sheets("Resultats BI 1")
Set sh2 = Sheets("Résumé BI")
Lastrow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
addr = "A2:H" & Lastrow
'--transfert---------------------------------------
sh2.Range(addr).Value = sh1.Range(addr).Value
End Sub

Merci beaucoup ça fonctionne

J'ai essayé de continuer le code pour la 2ème étape qui est de coller le 2ème tableau (resultat BI 2) directement à la suite de la dernière ligne : (j'ai appelé la feuille sh3 et je l'ai rajouté au début du coup)

"Sub test()

Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worsheet, Lastrow As Long, addr As String

Set sh1 = Sheets("Resultats BI 1")

Set sh2 = Sheets("Résumé BI")

Set sh3 = Sheets("Resultats BI 2")

Lastrow = sh1.Cells(Rows.Count, 1).End(xlUp).Row

addr = "A2:H" & Lastrow

'--transfert---------------------------------------

sh2.Range(addr).Value = sh1.Range(addr).Value

For i = Lastrow To 11

sh3.Select

Range("A2:H6").Select

Selection.Copy

Sheets("Résumé BI").Select

Selection.PasteSpecial xlValues, xlNone, False, False

Next i

End Sub"

Est ce que vous auriez une meilleure méthode pour cette étape ? ou est ce que vous pourriez corriger ce code svp car il ne fonctionne pas...

Merci beaucoup

re,

à tester,

attention j'ai mit le résultat sur une nouvelle feuille nommée "Résultat"

Sub test()
Dim sh1 As Worksheet, shA As Worksheet, shB As Worksheet, Lastrow As Long, addr As String

Set sh1 = Sheets("Résultat")  ' à adapter
Set shA = Sheets("Resultats BI 1")
Set shB = Sheets("Resultats BI 2")

v1 = shA.Range("A2:H" & shA.Cells(Rows.Count, 1).End(xlUp).Row).Value
v2 = shB.Range("A2:H" & shB.Cells(Rows.Count, 1).End(xlUp).Row).Value

sh1.Range("A2").Resize(UBound(v1), 8) = Application.Transpose(v1)
n = sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1
sh1.Range("A" & n).Resize(UBound(v2), 8) = Application.Transpose(v2)
End Sub

Re,

Merci beaucoup pour votre aide.

J'ai essayé de faire marcher cette macro et de résoudre les erreurs que je pouvais, mais il y a encore quelques problèmes :

  • 1er : Il n'y a que la première ligne qui s'affiche --> J'ai rajouté "A2:H2" et le problème est réglé, j'obtiens toutes les données
  • 2eme : Les données changent de sens et passent du mode horizontal (sur la tableau de résultats) en mode vertical
  • 3ème : Il y a des #NA à la suite des tableaux --> Est ce que c'est pas lié à cette partie du code "& shA.Cells" qui rajoute des lignes non utiles ?

Merci d'avance

re,

mea-culpa, j'avais transposer le tableau

à tester,

Sub test()
Dim sh1 As Worksheet, shA As Worksheet, shB As Worksheet, v1, v2

Set sh1 = Sheets("Résultat")  ' à adapter
Set shA = Sheets("Resultats BI 1")
Set shB = Sheets("Resultats BI 2")

sh1.Range("A2:H9").ClearContents

v1 = shA.Range("A2:H5").Value
v2 = shB.Range("A2:H5").Value

sh1.Range("A2").Resize(UBound(v1), 8) = v1
n = sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1
sh1.Range("A" & n).Resize(UBound(v2), 8) = v2
End Sub

Re,

Pas de soucis

La macro à tester ne marche toujours pas, le 2ème tableau n’apparaît pas sur l'onglet final. Ça à l'air vraiment compliqué, est ce que vous pensez qu'on peut y arriver ou il vaut mieux que j'essaie d'obtenir le tableau final d'une façon différente ?

Merci encore pour vos scripts à tester.

re,

à tester,

Ça fonctionne !!!

MERCI énormément pour votre aide !!

Rechercher des sujets similaires à "macro boucle copier coller lignes variables"