Copier/coller ligne sous condition dans excel

Soyez le premier à donner votre avis sur cette source.

Snippet vu 44 564 fois - Téléchargée 29 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

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

Ajouter un commentaire

Commentaires

Messages postés
3
Date d'inscription
jeudi 3 février 2011
Statut
Membre
Dernière intervention
8 février 2011

Merci beaucoup pour ton aide Nicostrong. Ca fonctionne!
Messages postés
6
Date d'inscription
vendredi 17 février 2006
Statut
Membre
Dernière intervention
7 février 2011

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
Messages postés
3
Date d'inscription
jeudi 3 février 2011
Statut
Membre
Dernière intervention
8 février 2011

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
Messages postés
3
Date d'inscription
jeudi 3 février 2011
Statut
Membre
Dernière intervention
8 février 2011

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
Messages postés
10
Date d'inscription
mercredi 22 décembre 2010
Statut
Membre
Dernière intervention
13 mars 2012

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
Afficher les 10 commentaires

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.