VBA :copie insere et coller qui marche pas

bigs32

XLDnaute Junior
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
 

Pièces jointes

  • test.xls
    45 KB · Affichages: 54
  • test.xls
    45 KB · Affichages: 59
  • test.xls
    45 KB · Affichages: 63

ERIC S

XLDnaute Barbatruc
Re : VBA :copie insere et coller qui marche pas

Bonjour

je pense que ton resize vide le buffer, donc il n'y a plus rien à coller

1/déterminer combien de lignes à insérer
2/insérer
3/copier
4/coller

cela devrait être mieux
 

Épaf

XLDnaute Occasionnel
Re : VBA :copie insere et coller qui marche pas

Bonjour,
Je suis d'accord avec Eric, Copy -> Paste doivent se suivre. Mais je vois autre chose. Je ne sais pas si je n'ai pas tout lu mais si zonecol est bien un range (plage de cellules)
nblignes = zonecol.Count ne donne pas le nombre de lignes. Pour l'avoir, il me semble qu'ici il faut mettre
nblignes = zonecol.Rows.Count
Sauf erreur de ma part dans la lecture du code proposé.
Bonne journée
 

Staple1600

XLDnaute Barbatruc
Re : VBA :copie insere et coller qui marche pas

Bonjour à tous


Toujours pour honorer mes endives, et pour éviter les Select et les boucles

(code brut de décoffrage , pas de gestion d'erreur )
Code:
Sub Macro1()
Sheets.Add.Name = "COPIE"
With Sheets("stats_sales_imp")
    .[A1].AutoFilter Field:=12, Criteria1:="<>"
    .[_FilterDataBase].SpecialCells(12).Copy Sheets("COPIE").[A1]
    .AutoFilterMode = False
End With
Sheets("COPIE").Range("B:C,E:K,M:Q,S:S").Delete
End Sub
 

bigs32

XLDnaute Junior
Re : VBA :copie insere et coller qui marche pas

Bonjour,
Je suis d'accord avec Eric, Copy -> Paste doivent se suivre. Mais je vois autre chose. Je ne sais pas si je n'ai pas tout lu mais si zonecol est bien un range (plage de cellules)
nblignes = zonecol.Count ne donne pas le nombre de lignes. Pour l'avoir, il me semble qu'ici il faut mettre
nblignes = zonecol.Rows.Count
Sauf erreur de ma part dans la lecture du code proposé.
Bonne journée
bizarre zonecol.Rows.Count donne toujours 1
 

Staple1600

XLDnaute Barbatruc
Re : VBA :copie insere et coller qui marche pas

Re

[EDITION] voici une version qui devrait éviter ce désagrément
Code:
Sub Macro1()
If fex("COPIE") Then
Application.DisplayAlerts = False
Sheets("COPIE").Delete
Application.DisplayAlerts = True
Else
Sheets.Add.Name = "COPIE"
With Sheets("stats_sales_imp")
    .[A1].AutoFilter Field:=12, Criteria1:="<>"
    .[_FilterDataBase].SpecialCells(12).Copy Sheets("COPIE").[A1]
    .AutoFilterMode = False
End With
Sheets("COPIE").Range("B:C,E:K,M:Q,S:S").Delete
End If
End Sub
Code:
Function fex(ByVal ws$) As Boolean
On Error Resume Next
fex = (Sheets(ws).Name <> "")
On Error GoTo 0
End Function
[/EDITION]


Message original
Cela c'est normal comme je le disais
(code brut de décoffrage , pas de gestion d'erreur )
mais tu n'avais pas dit que tu exécutais la macro 2 fois :confused:

Car en faisant cela tu créés une feuille qui existe déjà (la feuille COPIE)
d'ou le bug
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : VBA :copie insere et coller qui marche pas

Re

bigs32
Même question que tout à l'heure
Tu as testé la version modifiée ?


NB: en général, il est conseillé d'éviter les Select , Activate et cie


PS: dans ton code , tu ne déclares pas tes variables.
Pourquoi ?
 

Staple1600

XLDnaute Barbatruc
Re : VBA :copie insere et coller qui marche pas

Re

bigs32
Et si tu cliques une 3ème fois, cela te récréera ton onglet COPIE

Question: que veux-tu faire exactement ?

Mon code se borne à filtrer* les cellules non vides de la colonne qty cmd ok
puis à copie le résultat de ce filtre sur une nouvelle feuille nommée COPIE
(si cette feuille existe déjà , elle est supprimée)

(* en utilisant le filtre automatique avec VBA )
 
Dernière édition:

Statistiques des forums

Discussions
312 288
Messages
2 086 832
Membres
103 399
dernier inscrit
Tassiou