VBA :copie insere et coller qui marche pas

[bigs32]

bonjour
j'ai un fichier ci-dessous test.xls .j'ai crée un macro copier qui permet de copier la zone selectionnée de l'onglet stats_sales_imp vers l'onglet feuil1.
mais avant de coller , j'aimerais insérer dans feuil1 le nombre de ligne de la zone selectionnée de l'onglet stats_sales_imp.
j'ai essayé plusieurs méthodes aucun ne marche .
ca bloque toujours sur l'erreur ActiveSheet.Paste.
je ne comprends rien du tout .Ca fait 3h que je suis dessus.Si vous avez une idée .merci vraiment d'avance
voici le code et le fichier test.xls

Sub copie()
Set result_ligne = ActiveSheet.UsedRange.Rows(1).Find(What:="qty cmd ok")
Set plage = Range(result_ligne.Offset(1, 0), result_ligne.Offset(ActiveSheet.UsedRange.Rows.Count, 0).End(xlUp))
Set col = ActiveSheet.Range(result_ligne.Address)
Set col_1 = ActiveSheet.Range(result_ligne.Offset(0, -8).Address)
Set col_2 = ActiveSheet.Range(result_ligne.Offset(0, -11).Address)
Set col1 = ActiveSheet.Range(result_ligne.Offset(0, 6).Address)
For Each cellule In plage
If cellule > 0 Then
Set col = Application.Union(col, cellule)
Set col_1 = Application.Union(col_1, cellule.Offset(0, -8))
Set col_2 = Application.Union(col_2, cellule.Offset(0, -11))
Set col1 = Application.Union(col1, cellule.Offset(0, 6))
End If
Next cellule
Set zonecol = Application.Union(col, col_1, col_2, col1)
zonecol.Select
zonecol.Copy
Sheets("Feuil1").Activate
Sheets("Feuil1").Select
nblignes = zonecol.Count
nblignes = nblignes
'MsgBox nblignes
Range("A1").Resize(nblignes, 1).EntireRow.Insert
Rows("10:10").Insert Shift:=xlDown
Range("A1").Select
ActiveSheet.Paste
End Sub

 

[Staple1600]

Re : VBA :copie insere et coller qui marche pas

Bonsoir

bigs32
Quel est l'intérêt d'aller poser des questions sur un forum dédié à Excel et VBA
si c'est pour ne pas suivre les différents conseils reçus ?

D'ailleurs ta présence sur ce forum prouve que ton code marche vraiment trés bien

Tu as testé ou pas la dernière version que je te proposais ?

Et je repose ma question de tout à l'heure

Question: que veux-tu faire exactement ?

 

[bigs32]

Re : VBA :copie insere et coller qui marche pas

Bonsoir

bigs32
Quel est l'intérêt d'aller poser des questions sur un forum dédié à Excel et VBA
si c'est pour ne pas suivre les différents conseils reçus ?

D'ailleurs ta présence sur ce forum prouve que ton code marche vraiment trés bien

Tu as testé ou pas la dernière version que je te proposais ?

Et je repose ma question de tout à l'heure

bonsoir
désolé d'avoir répondu tard .je cherchais de mon coté .
ton code est bien mais j'ai un peu de mal à comprendre c'est pour celà que je ne peux l'utiliser car je ne saurais le modifier s'il y a un souci (trop balèze pour ma petite tete).J'ai suivi le conseil de ERIC S qui est plus simple et qui marche et qui correspond exactement à ce que je veux.
en tout cas merci quand meme pour ton aide Staple1600 et du temps que t'as passé pour moi

 

[Staple1600]

Re : VBA :copie insere et coller qui marche pas

Re

J'ai suivi le conseil de s qui est plus simple et qui marche et qui correspond à ce que je veux.
en tout cas merci quand meme pour ton aide

Tu peux poster ton code VBA final stp

Car je ne vois dans le fil de code VBA qui fonctionne
(a part le mien )

Tu n'as pas répondu à ma question
que veux-tu faire exactement ?
copier une zone sélectionnée ?
(mais selection faite sur quels critères ?)
et pourquoi lances-tu plusieurs fois ta macro ?

 

[bigs32]

Re : VBA :copie insere et coller qui marche pas

Re



Tu peux poster ton code VBA final stp

Car je ne vois dans le fil de code VBA qui fonctionne
(a part le mien )

Tu n'as pas répondu à ma question
que veux-tu faire exactement ?
copier une zone sélectionnée ?
(mais selection faite sur quels critères ?)
et pourquoi lances-tu plusieurs fois ta macro ?

voici le code final qui marche

Sub copie_vers_feuil1()
Set result_ligne = ActiveSheet.UsedRange.Rows(1).Find(What:="qty cmd ok")
Set plage = Range(result_ligne.Offset(1, 0), result_ligne.Offset(fin_li - 1, 0).End(xlUp))
Set col = ActiveSheet.Range(result_ligne.Address)
Set col_1 = ActiveSheet.Range(result_ligne.Offset(0, -8).Address)
Set col_2 = ActiveSheet.Range(result_ligne.Offset(0, 1).Address)
Set col1 = ActiveSheet.Range(result_ligne.Offset(0, -6).Address)
nblignes = 1
For Each cellule In plage
If cellule > 0 Then
Set col = Application.Union(col, cellule)
Set col_1 = Application.Union(col_1, cellule.Offset(0, -8))
Set col_2 = Application.Union(col_2, cellule.Offset(0, 1))
Set col1 = Application.Union(col1, cellule.Offset(0, -6))
nblignes = nblignes + 1
End If
Next cellule
Set zonecol = Application.Union(col, col_1, col_2, col1)
zonecol.Select
Sheets("Feuil1").Activate
'MsgBox nblignes
Range("A1").Resize(nblignes, 1).EntireRow.Insert
Sheets("stats_sales").Activate
zonecol.Copy
Sheets("Feuil1").Activate
Range("A1").Select
ActiveSheet.Paste
nb = ActiveSheet.UsedRange.Columns.Count
End Sub

il faut que If cellule > 0 et j'ai ajouté nblignes = nblignes + 1 à l'intérieur de la boucle For Each cellule In plage