Bon, c'est pas un jeu... voilà, j'ai ce code qui ne fonctionne pas
En effet, il est sencé remplir un tableau lorsqu'il trouve une référence identique. Si cette référence a déjà des données, il insère une ligne et remplie cette ligne supplémentaire.
Le problème, c'est que j'ai l'impression que ma boucle ne fini pas: si "nbr" a comme valeur 50, je vais avoir 50 lignes insérées, au lieu d'une seule.
Bref, étant novice, j'imagine que des programmateurs comme vous sauront trouver l'erreur en quelques secondes.
Sub erreur()
'je copie les données à insérer sur le tableau
Range("J5:P5").Copy
Workbooks.Open Filename:= _
"C:\Documents and Settings\mr\Mes documents\Quiksilver ancienne version\tableau.xls"
Range("AM2").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
' nbr correspond au nombre de lignes du tableau
Dim nbr As Integer
'je fais une boucle qui test la référence de chaque ligne
Dim boucle As Integer
nbr = Range("AC2")
For boucle = 0 To nbr Step 1
If Range("AM2") = Range("B10").Offset(boucle) Then
'si la référence n'a pas de données, alors je copie bêtement...
If Range("L10").Offset(boucle) = "" Then
Range("AN2:AS2").Copy
Range("L10").Offset(boucle).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("B10").Offset(boucle).Select
End If
'si il y a déja des données, j'insère une ligne, fais de la mise en page, et copie ensuite
If Range("L10").Offset(boucle) = Text Then
Rows("10:10").Offset(boucle).Insert shift:=xlUp
Range("B10:B11").Offset(boucle).MergeCells = True
Range("D10:D11").Offset(boucle).MergeCells = True
Range("E10:E11").Offset(boucle).MergeCells = True
Range("F10:F11").Offset(boucle).MergeCells = True
Range("G10:G11").Offset(boucle).MergeCells = True
Range("H10:H11").Offset(boucle).MergeCells = True
Range("I10:I11").Offset(boucle).MergeCells = True
Range("J10:J11").Offset(boucle).MergeCells = True
Range("B10:J11").Offset(boucle).VerticalAlignment = xlTop
Range("AN2:AS2").Copy
Range("L10").Offset(boucle).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'j'efface ma 1er copie
Range("AM2:AS2").ClearContents
End If
End If
Next boucle
'je ferme ma source
Windows("fiche entreprise.xls").Activate
Application.DisplayAlerts = False
Windows("fiche entreprise.xls").Close
Windows("tableau.xls").Activate
End Sub
---
Voilà, merci d'avance
PS: j'ai déjà pas mal posté sur ce site, et ai eu de l'aide de la part de Sabrina, que je remercie, et m'excuse de ne pas avoir donné suite à ma dernière demande, car j'ai préféré abandonner les "boites de dialogues".. Merci Sabrina