marnichou
Messages postés3Date d'inscriptionjeudi 3 février 2011StatutMembreDernière intervention 8 février 2011 8 févr. 2011 à 15:36
Merci beaucoup pour ton aide Nicostrong. Ca fonctionne!
nicostrong
Messages postés6Date d'inscriptionvendredi 17 février 2006StatutMembreDernière intervention 7 février 2011 7 févr. 2011 à 18:37
Salut Marnichou,
pour ton problème, la meilleur solution est celle proposé par Econs.
Tu définis des compteurs pour chacune de tes pages, puis lorsque tu fais ta boucle pour copier tes données, tu incrémente le compteur de la page, la valeur du compteur correspond au numéro de la ligne.
De cette manière, tu n'as plus de ligne vide dans tes pages.
Ton code devient donc:
Sub Button3_Click()
Dim i As Integer
Dim KindOfUpdate As String
CompteurS4 = 1
CompteurA4 = 1
CompteurD5 = 1
KindOfUpdate = MsgBox("Do you want to update file?", vbYesNo, "Update")
If KindOfUpdate = 6 Then
Worksheets("SAP").Activate
For i = 2 To 150
If Cells(i, 3) = "331123" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("S4").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
CompteurS4 = CompteurS4 + 1
ElseIf Cells(i, 3) = "331127" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("A4").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
CompteurA4 = CompteurA4 + 1
ElseIf Cells(i, 3) = "331145" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("D5").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
CompteurD5 = CompteurD5 + 1
End If
Next i
End If
Voilà.
@@++
Nicostrong
End Sub
marnichou
Messages postés3Date d'inscriptionjeudi 3 février 2011StatutMembreDernière intervention 8 février 2011 3 févr. 2011 à 17:48
Re-bonjour!
J'ai finalement réussi à faire tourner la macro; Voici le code :
MAIS j'ai un problème, dans les feuilles de destination (S4, A4 et D5), j'ai des lignes vides partout. Comment faire pour que les lignes se copient les unes en dessous des autres sans blancs? merci beaucoup!
Sub Button3_Click()
Dim i As Integer
Dim KindOfUpdate As String
KindOfUpdate = MsgBox("Do you want to update file?", vbYesNo, "Update")
If KindOfUpdate = 6 Then
Worksheets("SAP").Activate
For i = 2 To 150
If Cells(i, 3) = "331123" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("S4").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ElseIf Cells(i, 3) = "331127" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("A4").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ElseIf Cells(i, 3) = "331145" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("D5").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next i
End If
End Sub
marnichou
Messages postés3Date d'inscriptionjeudi 3 février 2011StatutMembreDernière intervention 8 février 2011 3 févr. 2011 à 11:46
Bonjour,
Je profite de la renommée de ce site pour chercher une réponse à ma question.
Voilà j'ai une extraction SAP brute. Je voudrais créer une macro qui selon le cost center copie/Colle les lignes de l'extraction SAP vers un onglet (un onglet par cost center). J'ai reprise la macro ci-dessus en l'adapatant à mon cas, mais je suis déburtante en VBA :-S
SAP est ma feuille d'extraction qui contient des données sur environ 600 lignes (j'ai mis 700 pour être large). Ma condition " cost center" se trouve en Colonne D
Private Sub CommandButton1_Click()
Dim don
Dim Ligne
Dim KindOfUpdate
KindOfUpdate = MsgBox("Do you want to update the file?", vbYesNo, "Update")
If KindOfUpdate = 6 Then
For i = 2 To 700
If Cells(i, 4) = Costcenter1 Then
Worksheets(SAP).Range("A" & i & ":J" & i).Copy
Worksheets(Costcenter1).Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipBlanks:= _
False, Transpose:=False
ElseIf Cells(i, 4) = Costcenter2 Then
Worksheets(SAP).Range("A" & i & ":J" & i).Copy
Worksheets(Costcenter2).Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipBlanks:= _
False, Transpose:=False
ElseIf Cells(i, 3) = 331145 Then
Worksheets(SAP).Range("A" & i & ":J" & i).Copy
Worksheets(331145).Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipBlanks:= _
False, Transpose:=False
End If
Next i
Worksheets(SAP).Range("A2").Select
End If
End Sub
Merci beaucoup pour votre aide
thaclemclem
Messages postés10Date d'inscriptionmercredi 22 décembre 2010StatutMembreDernière intervention13 mars 2012 27 déc. 2010 à 10:45
Salut Nicostrong,
Merci d'avoir répondu aussi vite, je me remets sur le problème que maintenant... :/
La feuille 4 est déjà créée... donc je ne vois pas d'où vient le soucis.
Toutefois, je viens à l'instant de résoudre le problème en placant la ligne n°3:
For i = 2 To nombre_ligne 'ton code
Worksheets("data").Range("A" & i & ":BR" & i).Copy 'ton code
Worksheets("data").Cells(i, 70).Activate 'la ligne qui supprime l'erreur !!!
if Cells(i, 70) = "aaa" Then 'ton code
En gros après avoir copié les cellules à dispatcher, je réactive la cellule de condition... et tout roule !!
Voila, merci pour ton aide, ainsi que pour le morceau de code qui m'a servi de base au dispatching des cellules de mon fichier.
++
Thaclemclem
nicostrong
Messages postés6Date d'inscriptionvendredi 17 février 2006StatutMembreDernière intervention 7 février 2011 22 déc. 2010 à 19:49
Salut thaclemclem,
l'erreur viens surement du fait que tu copies les données vers une feuille inexistante.
tu copies les données vers "monclasseur.xlsx" feuille n°4 , puis à la suite de ce qu'il y a déjà.
Donc soit tu modifies le numéro de la feuille, soit tu crée une feuille n°4.
J'espère que c'est sa l'erreur.
Dis nous quoi !!
@@++
Nicostrong
thaclemclem
Messages postés10Date d'inscriptionmercredi 22 décembre 2010StatutMembreDernière intervention13 mars 2012 22 déc. 2010 à 13:37
Bonjour à tous,
Je ne crois pas qu'il soit très courtois de rédémarrer un topic mort depuis près de quatre ans... mais il correspond en tous points à mon problème. Je m'explique, au lieu de dispatcher les lignes selon une condition sur d'autres feuilles au sein du même classeur, je souhaite dispatcher ces lignes sur un autre classeur... et la je recois une erreur du type Run-time'9' Subscript out of range.
Pour info, j'ai remplacé le code publié par ECONS le 20/02/2006 à 17h46 :
Worksheets(4).Range("A" & compteurFeuille4).PasteSpecial ........
par celui-ci :
Workbooks("monclasseur.xlsx").Worksheets(4).Range("A" & compteurFeuille4).PasteSpecial....
Je ne comprends pas vraiment cette erreur car mon code se trouve dans un module (certes rattaché au classeur où se trouve la macro et non dans un module rattaché au classeur cible).
Je vous remercie d'avance de vos retours.
ThaClemClem
bertrand1202
Messages postés2Date d'inscriptionjeudi 21 décembre 2006StatutMembreDernière intervention12 janvier 2007 12 janv. 2007 à 22:46
Bonsoir
cela me sera utile pour trier des donnees de type clients regles et non regles .
Puis je utiliser tel quelle cete procedure
Merci c est utile
A+
Bertrand 1202
TMONOD
Messages postés256Date d'inscriptionmardi 25 novembre 2003StatutMembreDernière intervention 6 novembre 20091 26 juin 2006 à 10:15
Bonjour,
Pour ce genre de problèmes, il est souvent préférable de travailler avec ADO. Tu nommes la plage que tu veux éclater et tu la traite comme une table. Dans les autres feuilles tu importes les données à partir de requêtes comme si elles venaient d'une source externe.
Les avantages sont nombreux. Si cela t'interresse je te donnerais quelques détails.
econs
Messages postés4030Date d'inscriptionmardi 13 mai 2003StatutMembreDernière intervention23 décembre 200824 20 févr. 2006 à 17:46
# Worksheets(2).Range("A" & i & ":K" & i).Copy
Cette instruction se trouve dans le THEN et dans le ELSE de ta condition. Il peut donc être sorti du IF.
Pour grouper toutes les lignes vers le haut, utilise des compteurs sur chaque feuille.
TON CODE DEVIENT ALORS :
===============================================
Private Sub CommandButton3_Click()
Dim don As Long
Dim ligne As Long
dim compteurFeuille3 As Long
dim compteurFeuille4 As Long
don = 120
compteurFeuille3=1
compteurFeuille4=1
For i = 2 To 150
Worksheets(2).Range("A" & i & ":K" & i).Copy
If Cells(i, 9) < don Then
Worksheets(4).Range("A" & compteurFeuille4).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
compteurFeuille4=compteurFeuille4+1
Else
Worksheets(3).Range("A" & compteurFeuille3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
compteurFeuille3=compteurFeuille3+1
End If
Next i
Worksheets(2).Range("A2").Select
End Sub
===============================================
A part çà, pas grand chose à dire. Ca semble restreint à un problème que toi seul as rencontré.
8 févr. 2011 à 15:36
7 févr. 2011 à 18:37
pour ton problème, la meilleur solution est celle proposé par Econs.
Tu définis des compteurs pour chacune de tes pages, puis lorsque tu fais ta boucle pour copier tes données, tu incrémente le compteur de la page, la valeur du compteur correspond au numéro de la ligne.
De cette manière, tu n'as plus de ligne vide dans tes pages.
Ton code devient donc:
Sub Button3_Click()
Dim i As Integer
Dim KindOfUpdate As String
CompteurS4 = 1
CompteurA4 = 1
CompteurD5 = 1
KindOfUpdate = MsgBox("Do you want to update file?", vbYesNo, "Update")
If KindOfUpdate = 6 Then
Worksheets("SAP").Activate
For i = 2 To 150
If Cells(i, 3) = "331123" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("S4").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
CompteurS4 = CompteurS4 + 1
ElseIf Cells(i, 3) = "331127" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("A4").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
CompteurA4 = CompteurA4 + 1
ElseIf Cells(i, 3) = "331145" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("D5").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
CompteurD5 = CompteurD5 + 1
End If
Next i
End If
Voilà.
@@++
Nicostrong
End Sub
3 févr. 2011 à 17:48
J'ai finalement réussi à faire tourner la macro; Voici le code :
MAIS j'ai un problème, dans les feuilles de destination (S4, A4 et D5), j'ai des lignes vides partout. Comment faire pour que les lignes se copient les unes en dessous des autres sans blancs? merci beaucoup!
Sub Button3_Click()
Dim i As Integer
Dim KindOfUpdate As String
KindOfUpdate = MsgBox("Do you want to update file?", vbYesNo, "Update")
If KindOfUpdate = 6 Then
Worksheets("SAP").Activate
For i = 2 To 150
If Cells(i, 3) = "331123" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("S4").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ElseIf Cells(i, 3) = "331127" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("A4").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ElseIf Cells(i, 3) = "331145" Then
Worksheets("SAP").Range("A" & i & ":N" & i).Copy
Sheets("D5").Range("C" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next i
End If
End Sub
3 févr. 2011 à 11:46
Je profite de la renommée de ce site pour chercher une réponse à ma question.
Voilà j'ai une extraction SAP brute. Je voudrais créer une macro qui selon le cost center copie/Colle les lignes de l'extraction SAP vers un onglet (un onglet par cost center). J'ai reprise la macro ci-dessus en l'adapatant à mon cas, mais je suis déburtante en VBA :-S
SAP est ma feuille d'extraction qui contient des données sur environ 600 lignes (j'ai mis 700 pour être large). Ma condition " cost center" se trouve en Colonne D
Private Sub CommandButton1_Click()
Dim don
Dim Ligne
Dim KindOfUpdate
KindOfUpdate = MsgBox("Do you want to update the file?", vbYesNo, "Update")
If KindOfUpdate = 6 Then
For i = 2 To 700
If Cells(i, 4) = Costcenter1 Then
Worksheets(SAP).Range("A" & i & ":J" & i).Copy
Worksheets(Costcenter1).Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipBlanks:= _
False, Transpose:=False
ElseIf Cells(i, 4) = Costcenter2 Then
Worksheets(SAP).Range("A" & i & ":J" & i).Copy
Worksheets(Costcenter2).Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipBlanks:= _
False, Transpose:=False
ElseIf Cells(i, 3) = 331145 Then
Worksheets(SAP).Range("A" & i & ":J" & i).Copy
Worksheets(331145).Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipBlanks:= _
False, Transpose:=False
End If
Next i
Worksheets(SAP).Range("A2").Select
End If
End Sub
Merci beaucoup pour votre aide
27 déc. 2010 à 10:45
Merci d'avoir répondu aussi vite, je me remets sur le problème que maintenant... :/
La feuille 4 est déjà créée... donc je ne vois pas d'où vient le soucis.
Toutefois, je viens à l'instant de résoudre le problème en placant la ligne n°3:
For i = 2 To nombre_ligne 'ton code
Worksheets("data").Range("A" & i & ":BR" & i).Copy 'ton code
Worksheets("data").Cells(i, 70).Activate 'la ligne qui supprime l'erreur !!!
if Cells(i, 70) = "aaa" Then 'ton code
En gros après avoir copié les cellules à dispatcher, je réactive la cellule de condition... et tout roule !!
Voila, merci pour ton aide, ainsi que pour le morceau de code qui m'a servi de base au dispatching des cellules de mon fichier.
++
Thaclemclem
22 déc. 2010 à 19:49
l'erreur viens surement du fait que tu copies les données vers une feuille inexistante.
"Workbooks("monclasseur.xlsx").Worksheets(4).Range("A" & compteurFeuille4).PasteSpecial.."
tu copies les données vers "monclasseur.xlsx" feuille n°4 , puis à la suite de ce qu'il y a déjà.
Donc soit tu modifies le numéro de la feuille, soit tu crée une feuille n°4.
J'espère que c'est sa l'erreur.
Dis nous quoi !!
@@++
Nicostrong
22 déc. 2010 à 13:37
Je ne crois pas qu'il soit très courtois de rédémarrer un topic mort depuis près de quatre ans... mais il correspond en tous points à mon problème. Je m'explique, au lieu de dispatcher les lignes selon une condition sur d'autres feuilles au sein du même classeur, je souhaite dispatcher ces lignes sur un autre classeur... et la je recois une erreur du type Run-time'9' Subscript out of range.
Pour info, j'ai remplacé le code publié par ECONS le 20/02/2006 à 17h46 :
Worksheets(4).Range("A" & compteurFeuille4).PasteSpecial ........
par celui-ci :
Workbooks("monclasseur.xlsx").Worksheets(4).Range("A" & compteurFeuille4).PasteSpecial....
Je ne comprends pas vraiment cette erreur car mon code se trouve dans un module (certes rattaché au classeur où se trouve la macro et non dans un module rattaché au classeur cible).
Je vous remercie d'avance de vos retours.
ThaClemClem
12 janv. 2007 à 22:46
cela me sera utile pour trier des donnees de type clients regles et non regles .
Puis je utiliser tel quelle cete procedure
Merci c est utile
A+
Bertrand 1202
26 juin 2006 à 10:15
Pour ce genre de problèmes, il est souvent préférable de travailler avec ADO. Tu nommes la plage que tu veux éclater et tu la traite comme une table. Dans les autres feuilles tu importes les données à partir de requêtes comme si elles venaient d'une source externe.
Les avantages sont nombreux. Si cela t'interresse je te donnerais quelques détails.
20 févr. 2006 à 17:46
Cette instruction se trouve dans le THEN et dans le ELSE de ta condition. Il peut donc être sorti du IF.
Pour grouper toutes les lignes vers le haut, utilise des compteurs sur chaque feuille.
remplace ceci :
------------------------------------------------------------------
Worksheets(3).Range("A" & i).PasteSpecial Paste:=xlPasteAll, ...
------------------------------------------------------------------
par :
------------------------------------------------------------------
Worksheets(3).Range("A" & compteurFeuille3).PasteSpecial Paste:=xlPasteAll, ...
compteurFeuille3 = compteurFeuille3 + 1
------------------------------------------------------------------
TON CODE DEVIENT ALORS :
===============================================
Private Sub CommandButton3_Click()
Dim don As Long
Dim ligne As Long
dim compteurFeuille3 As Long
dim compteurFeuille4 As Long
don = 120
compteurFeuille3=1
compteurFeuille4=1
For i = 2 To 150
Worksheets(2).Range("A" & i & ":K" & i).Copy
If Cells(i, 9) < don Then
Worksheets(4).Range("A" & compteurFeuille4).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
compteurFeuille4=compteurFeuille4+1
Else
Worksheets(3).Range("A" & compteurFeuille3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
compteurFeuille3=compteurFeuille3+1
End If
Next i
Worksheets(2).Range("A2").Select
End Sub
===============================================
A part çà, pas grand chose à dire. Ca semble restreint à un problème que toi seul as rencontré.