Copier/coller ligne sous condition dans excel
Soyez le premier à donner votre avis sur cette source.
Snippet vu 44 876 fois - Téléchargée 31 fois
Contenu du snippet
Bonjour,
Voiçi un petit code qui permet via un bouton de trier les données d'un tableau et de les dispatcher dans deux autre feuilles.
Sachent que la première ligne est pour les titres des collones, on commence à la seconde ligne. La variable "don" est ma condition. Je n'annalyse que les 150 première lignes du tableau. Si les valleur dans les case de la 9 ème colonne sont < à ma variable don, je copie la ligne et la colle dans une feuile, même chose si la valleur est > à la variable.
Il y a moyens de faire un tri automatique à la fin de la comparaisonce qui aura pour effet de rassembler toutes les données vers le haut de la feuille et pas dicéminée dans tout le tableau.
Voilà.
Aller.
@@++
Nicostrong
Voiçi un petit code qui permet via un bouton de trier les données d'un tableau et de les dispatcher dans deux autre feuilles.
Sachent que la première ligne est pour les titres des collones, on commence à la seconde ligne. La variable "don" est ma condition. Je n'annalyse que les 150 première lignes du tableau. Si les valleur dans les case de la 9 ème colonne sont < à ma variable don, je copie la ligne et la colle dans une feuile, même chose si la valleur est > à la variable.
Il y a moyens de faire un tri automatique à la fin de la comparaisonce qui aura pour effet de rassembler toutes les données vers le haut de la feuille et pas dicéminée dans tout le tableau.
Voilà.
Aller.
@@++
Nicostrong
Source / Exemple :
Private Sub CommandButton3_Click()
Dim don
Dim ligne
don = 120
For i = 2 To 150
If Cells(i, 9) < don Then
Worksheets(2).Range("A" & i & ":K" & i).Copy
Worksheets(4).Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Else
Worksheets(2).Range("A" & i & ":K" & i).Copy
Worksheets(3).Range("A" & i).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next i
Worksheets(2).Range("A2").Select
End Sub
A voir également
- Copier/coller ligne sous condition dans excel
- Copier une ligne entre 2 tableaux excel ✓ - Forum - Visual Basic 6
- COPIER/COLLER LIGNES ✓ - Forum - Visual Basic 6
- Excel vba copier coller plusieurs lignes - Forum - Visual Basic
- [Déplacé VB6 --> VBA] Excel Copier coller avec une macro sous condition ✓ - Forum - Visual Basic 6
- Copier une ligne et nombre de lignes VBA Excel ✓ - Forum - Visual Basic
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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.