Regroupement de données dans une feuille

Le 31/10/2012 à 10:47

Bonjour,

Je joins un .doc pour être plus précis sur ma demande mais en gros je voudrai que dans un endroit précis dans une feuille se répercutent les valeurs saisies dans 3 zones de cette même feuille. Opération qui me permettrait de pouvoir faire un tri correctement.

Je joins un code (ci-dessous) mais il ne fonctionne pas car j'ai la ligne

With Wb.Sheets("ConstatsISO9001")

qui est en jaune.

Merci pour votre aide.

Code complet :

Private Sub CommandButton1_Click() 'en cours de réalisation'
Dim Wb As Workbook
With Wb.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("G" & k) <> "" Then

    Range(AO501).Value = .Range("B" & k).Value
    Range(AP501).Value = .Range("C" & k).Value
    Range(AQ501).Value = .Range("D" & k).Value
    Range(AR501).Value = .Range("E" & k).Value
    Range(AS501).Value = .Range("F" & k).Value
    Range(AT501).Value = .Range("G" & k).Value
    End If
Next
End With

With Wb.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("M" & k) <> "" Then

    Range(AO501).Value = .Range("B" & k).Value
    Range(AP501).Value = .Range("I" & k).Value
    Range(AQ501).Value = .Range("J" & k).Value
    Range(AR501).Value = .Range("K" & k).Value
    Range(AS501).Value = .Range("L" & k).Value
    Range(AT501).Value = .Range("M" & k).Value
    End If
Next
End With

With Wb.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("S" & k) <> "" Then

    Range(AO501).Value = .Range("B" & k).Value
    Range(AP501).Value = .Range("O" & k).Value
    Range(AQ501).Value = .Range("P" & k).Value
    Range(AR501).Value = .Range("Q" & k).Value
    Range(AS501).Value = .Range("R" & k).Value
    Range(AT501).Value = .Range("S" & k).Value
    End If
Next
End With
End Sub
9texte-macro-copier-donnees-dans-autres-cellules-meme-feuille.zip (5.81 Ko)
Le 31/10/2012 à 13:30

Bonjour,

Normal que ta ligne ne fonctionne pas.

Tu déclares wb comme workbook mais plus bas tu ne dis pas quel workbook

Si ta macro se trouve dans le fichier où se trouve ta feuille ConstatsISO9001, essaie plutôt ceci -->

With Thisworkbook.Sheets("ConstatsISO9001")

Si ok, lors de ta réponse clique sur le V vert pour cloturer le fil de ta demande

Amicalement

Le 31/10/2012 à 17:37

Bonjour Dan,

Oui ma macro se trouve dans le fichier où se trouve ma feuille.

J'ai fais le changement mais maintenant c'est la ligne suivante qui s'affiche en jaune

Range(AO501).Value = .Range("B" & k).Value
Le 31/10/2012 à 19:18

Bonjour

Tes références de cellules entre " " (guillemets)

Range("AO501").Value = .Range("B" & k).Value
Le 14/11/2012 à 13:39

Merci pour vos réponses.

J'ai modifié le code car je me suis aperçu qu'en mettant le numéro de cellule dans le code (ex :

Range("AO501").Value = .Range("B" & k).Value

, il ne me prenait que les dernières valeurs qu'il me recopait dans les cellules AO501, AP501,... alors que je souhaite avoir toutes les valeurs et que ces valeurs soient recopiées dès la cellule AO501, AP501, AQ501, AR501, AS501 et AT501 et qu'il continue avec la cellule AO502, AP502, AQ502, AR502, AS502, AT502,...

Donc j'ai refais le code (voir ci-après) mais ce code ne recopie rien, j'ai même pas de message d'erreur. Si vous pouviez m'éclairer.

Private Sub CommandButton1_Click() 'en cours de réalisation'
Dim Wb As Workbook
With ThisWorkbook.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("G" & k) <> "" Then
    lig = [I65536].End(3).Row + 1
    Range("AO" & lig).Value = .Range("B" & k).Value
    Range("AP" & lig).Value = .Range("C" & k).Value
    Range("AQ" & lig).Value = .Range("D" & k).Value
    Range("AR" & lig).Value = .Range("E" & k).Value
    Range("AS" & lig).Value = .Range("F" & k).Value
    Range("AT" & lig).Value = .Range("G" & k).Value
    End If
Next
End With

With ThisWorkbook.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("M" & k) <> "" Then
    lig = [I65536].End(3).Row + 1
    Range("AO" & lig).Value = .Range("B" & k).Value
    Range("AP" & lig).Value = .Range("I" & k).Value
    Range("AQ" & lig).Value = .Range("J" & k).Value
    Range("AR" & lig).Value = .Range("K" & k).Value
    Range("AS" & lig).Value = .Range("L" & k).Value
    Range("AT" & lig).Value = .Range("M" & k).Value
    End If
Next
End With

With ThisWorkbook.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("S" & k) <> "" Then
    lig = [I65536].End(3).Row + 1
    Range("AO" & lig).Value = .Range("B" & k).Value
    Range("AP" & lig).Value = .Range("O" & k).Value
    Range("AQ" & lig).Value = .Range("P" & k).Value
    Range("AR" & lig).Value = .Range("Q" & k).Value
    Range("AS" & lig).Value = .Range("R" & k).Value
    Range("AT" & lig).Value = .Range("S" & k).Value
    End If
Next
End With
End Sub
Le 14/11/2012 à 13:46

Bonjour

110 messages et personne ne t'a dit qu'avec un fichier cela serait mieux

Alors je serais le premier "Avec un fichier cela serait mieux"

Tu expliques ce tu veux comme résultat (fais un exemple) afin que l'on comprenne bien

Je pense que c'est plus le même qu'au départ de ce post

Le 14/11/2012 à 13:56

Je joins un fichier word qui sera plus explicite que de tout détailler dans le post.

7texte-macro-copier-donnees-dans-autres-cellules-meme-feuille.zip (5.95 Ko)
Le 14/11/2012 à 14:21

Bonjour

thomasdu40 a écrit :

Je joins un fichier word qui sera plus explicite que de tout détailler dans le post.

Je suis d'accord avec toi mais il manque toujours le fichier excel avec un (au moins) exemple de résultat attendu

Le 14/11/2012 à 15:00

Le voici. Il contient le dernier code que j'ai intégré dans le bouton intitulé "Tri" et présent dans la feuille constatsISO9001. J'ai saisi aléatoirement des exemples dans le tableau dès la ligne 12. Ces exemples je les ai recopiés dans la zone de tri (cellule AO501).

Au final je voudrai le même résultat via un code vba. N'hésites pas si tu veux plus d'infos.

Moi je continue de mon côté.

8fichier-tri.xlsm (32.39 Ko)
Le 14/11/2012 à 15:50

Bonjour

Avec ce code on fait d'abord la colonne G, puis la M et enfin la S

On pourrait traiter les 3 cellules dans la même boucle

Private Sub CommandButton1_Click() 'en cours de réalisation'
Dim K As Long
Dim Lig As Long
Dim DerLig As Long

  Lig = 500
  With Sheets("ConstatsISO9001")
    .Rows("500:" & Rows.Count).Delete
    DerLig = .Range("B" & Rows.Count).End(xlUp).Row
    For K = 12 To DerLig
      If .Range("G" & K) <> "" Then
        Lig = Lig + 1
        .Range("AO" & Lig).Value = .Range("B" & K).Value
        .Range("AP" & Lig).Value = .Range("C" & K).Value
        .Range("AQ" & Lig).Value = .Range("D" & K).Value
        .Range("AR" & Lig).Value = .Range("E" & K).Value
        .Range("AS" & Lig).Value = .Range("F" & K).Value
        .Range("AT" & Lig).Value = .Range("G" & K).Value
      End If
    Next K

    For K = 12 To DerLig
      If .Range("M" & K) <> "" Then
        Lig = Lig + 1
        .Range("AO" & Lig).Value = .Range("B" & K).Value
        .Range("AP" & Lig).Value = .Range("I" & K).Value
        .Range("AQ" & Lig).Value = .Range("J" & K).Value
        .Range("AR" & Lig).Value = .Range("K" & K).Value
        .Range("AS" & Lig).Value = .Range("L" & K).Value
        .Range("AT" & Lig).Value = .Range("M" & K).Value
      End If
    Next K

    For K = 12 To DerLig
      If .Range("S" & K) <> "" Then
        Lig = Lig + 1
        .Range("AO" & Lig).Value = .Range("B" & K).Value
        .Range("AP" & Lig).Value = .Range("O" & K).Value
        .Range("AQ" & Lig).Value = .Range("P" & K).Value
        .Range("AR" & Lig).Value = .Range("Q" & K).Value
        .Range("AS" & Lig).Value = .Range("R" & K).Value
        .Range("AT" & Lig).Value = .Range("S" & K).Value
      End If
    Next K
  End With
End Sub
Le 14/11/2012 à 16:30

Merci pour ton retour et je te confirme que le code fonctionne même si tu le savais déjà.

Mais je suis extrêmement étonné que le code initial, que j'ai complété afin d'y intégrer la ligne

lig = 500

et afin de modifier la ligne

lig = [I65536].End(3).Row + 1

pour la transformer en

lig = lig + 1

et ceci grâce à tes codes, ne fonctionne qu'au trois quart.

J'ai les infos de la colonne G et M qui sont répercutées dans mon tableau de tri. Mais il ne veut pas me recopier la colonne S dans le cas où celle-ci serait complétée.

Private Sub CommandButton1_Click() 'en cours de réalisation'
Dim Wb As Workbook
lig = 500
With ThisWorkbook.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("G" & k) <> "" Then
    lig = lig + 1
    Range("AO" & lig).Value = .Range("B" & k).Value
    Range("AP" & lig).Value = .Range("C" & k).Value
    Range("AQ" & lig).Value = .Range("D" & k).Value
    Range("AR" & lig).Value = .Range("E" & k).Value
    Range("AS" & lig).Value = .Range("F" & k).Value
    Range("AT" & lig).Value = .Range("G" & k).Value
    End If
Next
End With

With ThisWorkbook.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("M" & k) <> "" Then
    lig = lig + 1
    Range("AO" & lig).Value = .Range("B" & k).Value
    Range("AP" & lig).Value = .Range("I" & k).Value
    Range("AQ" & lig).Value = .Range("J" & k).Value
    Range("AR" & lig).Value = .Range("K" & k).Value
    Range("AS" & lig).Value = .Range("L" & k).Value
    Range("AT" & lig).Value = .Range("M" & k).Value
    End If
Next
End With

With ThisWorkbook.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("S" & k) <> "" Then
    lig = lig + 1
    Range("AO" & lig).Value = .Range("B" & k).Value
    Range("AP" & lig).Value = .Range("O" & k).Value
    Range("AQ" & lig).Value = .Range("P" & k).Value
    Range("AR" & lig).Value = .Range("Q" & k).Value
    Range("AS" & lig).Value = .Range("R" & k).Value
    Range("AT" & lig).Value = .Range("S" & k).Value
    End If
Next
End With
End Sub
Le 14/11/2012 à 17:38

Bonjour

Si tu recopies le code copies le entièrement

Dans ce cas ce n'est pas important, mais tu n'as pas mis les points devant Range

J'avais englobé les 3 boucles dans le With .... End With

J'avais calculé une seule fois le nombre de ligne

Mais cela ne devrait pas empêcher la recopie si la cellule S.. est non vide

Ton fichier en faute devrait aider à trouver la solution

Le 14/11/2012 à 18:11

Oui j'avais vu que tu avais englobé les 3 boucles dans With.... End With. Pour mon code ce n'est pas le cas et comme les 2 premières boucles avec With... End With fonctionne je me suis dis que la 3ème boucle devrait fonctionner aussi. Ben non et j'ai beau essayer de trouver une solution pour que cette 3èm boucle fonctionne, rien n'y fait. Même en mettant les . devant range.

Ce code qui est la 3ème boucle correspondant à la colonne S m'ennerve vraiment :

With ThisWorkbook.Sheets("ConstatsISO9001")
For k = 12 To .[A65536].End(3).Row
    If .Range("S" & k) <> "" Then
    lig = lig + 1
    .Range("AO" & lig).Value = .Range("B" & k).Value
    .Range("AP" & lig).Value = .Range("O" & k).Value
    .Range("AQ" & lig).Value = .Range("P" & k).Value
    .Range("AR" & lig).Value = .Range("Q" & k).Value
    .Range("AS" & lig).Value = .Range("R" & k).Value
    .Range("AT" & lig).Value = .Range("S" & k).Value
    End If
Next
End With
Le 14/11/2012 à 18:54

Bonjour

Que dire/faire/penser ?

Fais du pas à pas

Fournis le fichier en cause

La colonne S ne contient pas de données

Le 15/11/2012 à 16:40

Ca y est. Problème résolu.

La solution va vous paraitre bizarre mais j'ai uniquement changé le 3 qui était dans la ligne

For K = 12 To .[A65536].End(3).Row

en 2. Là j'ai toutes les infos présentes dans les cellules qui s'affichent dans la zone réservée au tri.

Voici le code final :

Private Sub CommandButton1_Click() 'en cours de réalisation'
Dim Wb As Workbook
Lig = 500
With ThisWorkbook.Sheets("ConstatsISO9001")
For K = 12 To .[A65536].End(2).Row
    If .Range("G" & K) <> "" Then
    Lig = Lig + 1
    Range("AO" & Lig).Value = .Range("B" & K).Value
    Range("AP" & Lig).Value = .Range("C" & K).Value
    Range("AQ" & Lig).Value = .Range("D" & K).Value
    Range("AR" & Lig).Value = .Range("E" & K).Value
    Range("AS" & Lig).Value = .Range("F" & K).Value
    Range("AT" & Lig).Value = .Range("G" & K).Value
    End If
Next
End With

With ThisWorkbook.Sheets("ConstatsISO9001")
For K = 12 To .[A65536].End(2).Row
    If .Range("M" & K) <> "" Then
    Lig = Lig + 1
    Range("AO" & Lig).Value = .Range("B" & K).Value
    Range("AP" & Lig).Value = .Range("I" & K).Value
    Range("AQ" & Lig).Value = .Range("J" & K).Value
    Range("AR" & Lig).Value = .Range("K" & K).Value
    Range("AS" & Lig).Value = .Range("L" & K).Value
    Range("AT" & Lig).Value = .Range("M" & K).Value
    End If
Next
End With

With ThisWorkbook.Sheets("ConstatsISO9001")
For K = 12 To .[A65536].End(2).Row
    If .Range("S" & K) <> "" Then
    Lig = Lig + 1
    Range("AO" & Lig).Value = .Range("B" & K).Value
    Range("AP" & Lig).Value = .Range("O" & K).Value
    Range("AQ" & Lig).Value = .Range("P" & K).Value
    Range("AR" & Lig).Value = .Range("Q" & K).Value
    Range("AS" & Lig).Value = .Range("R" & K).Value
    Range("AT" & Lig).Value = .Range("S" & K).Value
    End If
Next
End With
Unload Me
End Sub
Le 15/11/2012 à 18:07

Bonjour

Bravo si tu as trouvé

Comme je n'utilise pas cette syntaxe, elle ne me paraissait pas suspecte

Rechercher des sujets similaires à "regroupement donnees feuille"