Macro excel triage et copie de nombre

[Résolu/Fermé]
Signaler
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
-
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
-
Bonjour,

Question: j'ai une liste de numeros de 8000 à 30000 dans la colonne A d'une feuille, puis des feuilles nommées 8000,9000,10000 . . . . .30000 je suis en train de chercher un code et quelque chose me dis que je part dans la compléxité, donc je vais demander avant. . . je voudrais une macro qui regarde tous ces numéros, et qui face quelque chose du genre:

copier toutes les valeurs comprises entre 8000 et 8999 dans feuille 8000 à partir de A1, copier toutes les valeurs comprises entre 9000 et 9999 dans la feuille 9000 à partir de A1 . . . 30000

donc je partai là ,dans un code avec une boucle et des if cells(a,1) > 8000 and < 8999 then activecells.copy bla bla bla mais quelque chose me dit que pour un pro macroiste il doit y avoir plus facile . . .


Je me trompe?

Cordialement

8 réponses

Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
bon j'ai bien trop de problèmes là donc je viens de trier manuelement mes series je n'aurais normalement plus à le faire par la suite je met le post résolu et te remerci pour ton aide pijaku,j'ai gardé ton code qui pourrai marcher dans un autre tableau au besoin

Merci encore
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41713 internautes nous ont dit merci ce mois-ci

Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 652
Salut,
Loin d'être un pro, je te suggère ceci avec la fonction find :

Sub selection_copie_en_fonction_du_premier_chiffre ()
Dim i As Integer
Dim val As String, val2 As String
Dim Plage As Range
val2 = Range("A2").Address
For i = 9 To 20
Set cel = Cells.Find(i & "000", LookIn:=xlValues, lookat:=xlPart).Offset(-1, 0)
val = cel.Address
Set Plage = Range(val2 & ":" & val)
Plage.Copy Sheets(i & "000").Range("A65536").End(xlUp)
Set cel = Cells.Find(i & "000", LookIn:=xlValues, lookat:=xlPart)
val2 = cel.Address
Next
Set cel = Nothing
Set Plage = Nothing
End Sub


Tiens nous au "jus"...
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
salut,

euh je suis pas sur de savoir quoi adapter :s tu peut mettre des commentaires s'il te plait sur ton code .. .

Merci
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 652
Salut,
Oups! Pardon... Avec commentaires ci dessous.
Le but est de rechercher les nombres se terminant par 000 en ne changeant donc que les "milliers". On détermine donc une variable i (de 9 à 30 dans ton cas) pour pouvoir rechercher la cellule qui contient "i000". Une fois cette cellule trouvée, on note son adresse dans une autre variable (val). Ensuite on sélectionne une plage délimitée par 2 variables val2 que l'on définit comme la première cellule de la plage, et val qui est définit ci dessus... On copie cette plage et on la colle dans la bonne feuille, en l'occurence Sheets(i & "000") :

Sub selection_copie_en_fonction_du_premier_chiffre ()
Dim i As Integer
Dim val As String, val2 As String
Dim Plage As Range
val2 = Range("A2").Address 'détermine l'adresse de la première cellule de ma 1ère plage
For i = 9 To 30 'pour "sélectionner" les cellules contenant 9000, 10000 etc jusqu'à 30000 dans ton cas
Set cel = Cells.Find(i & "000", LookIn:=xlValues, lookat:=xlPart).Offset(-1, 0) 'recherche la cellule contenant i000 et stocke la cellule du dessus (ben oui on veux une plage de 8000 à 8999 par exemple)
val = cel.Address 'détermine l'adresse de la 2ème borne de notre plage (soit l'adresse de la cellule stockée la ligne précédente)
Set Plage = Range(val2 & ":" & val) 'définit notre plage
Plage.Copy Sheets(i & "000").Range("A65536").End(xlUp) 'réalise la copie et colle sur la bonne feuille (Range("A65536").End(xlUp) je crois que tu connais, c'est la 1ère cellule vide de la colonne A)
Set cel = Cells.Find(i & "000", LookIn:=xlValues, lookat:=xlPart) 'cherche et stocke à nouveau la cellule i000
val2 = cel.Address 'stocke l'adresse de la cellule recherchée ci-dessus qui maintenant sert de 1ère borne à notre plage
Next
Set cel = Nothing 'on purge les variables
Set Plage = Nothing
End Sub


Cela te convient il mieux?
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
ah oui lol ça me parle plus meme si j'ai fais quelques macro depuis quelques mois je ne comprend pas toujours tous là c'est mieux . . . .

alors j'ai testé mais euuuh j'ai la variable 'cel' qui n'est pas déclarée je l'ai donc déclaré object car pour le for next on ne peux aparement la déclarer que comme ça ou comme variant mais il ne veut toujours pas la faire marcher :s il dit variable objet ou de bloc with non défini

voici le code:

Private Sub Worksheet_Calculate()
Dim i As Integer
Dim val As String, val2 As String
Dim Plage As Range
Dim cel As Object

val2 = Range("A2").Address
For i = 8 To 31
Set cel = Cells.Find(i & "000", LookIn:=xlValues, lookat:=xlPart).Offset(-1, 0)
val = cel.Address
Set Plage = Range(val2 & ":" & val)
Plage.Copy Sheets(i & "000").Range("A65536").End(xlUp)
Set cel = Cells.Find(i & "000", LookIn:=xlValues, lookat:=xlPart)
val2 = cel.Address
Next
Set cel = Nothing
Set Plage = Nothing
End Sub


Merci pour les commentaires
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 652
Moi je ne l'ai pas déclarée en début de macro mais en faisant set ... = .... et cela fonctionne bien chez moi. En tout cas, cel ne peux pas être un object.
Ensuite, si "i" commence à 8, il va te chercher "8" & "000" et donc ne sélectionner que la 1ère cellule. A moins que tes valeurs ne commencent par 7000 et quelques, sinon commence bien à 9.
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
j'ai remi donc 9 et 30 lol je pensai que tu avais fais une erreur mais c'est moi qui avai mal compris lol j'ai enlever la declaration de variable et supprimer mon option explicite qui m incite à declarer les variable et toujours le meme problème :s flute mais en y reflechissant ce travaille là je peux peut etre le faire manuelement car je n'aurai à le faire qu'une seule fois si je reflechi bien à la suite de mon problème ;)
Messages postés
16523
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
28 septembre 2021
3 229
Bonjour,

A la demande de PÏjaku par MP ci joint proposition à compléter( c'est long et ch...t), je me suis arrêter à 12000....
nota: valable s'il s'agit de nombres dans la feuille d'origine et non de nombres au format texte genre '12345 classique dans les imports de base de données externes

Dim tab8, tab9, tab10, tab11, Tab12 '.... jusqu'à tab29
Dim n8, n9, n10, n11, n12 '....jusqu'à n29

Sub dispatcher()
ReDim tab8(0)
ReDim tab9(0)
ReDim tab10(0)
ReDim tab11(0)
ReDim Tab12(0)
'.... jusquà redim tab29
derlig = Range("A65536").End(3).Row
For cptr = 1 To derlig
    mil = Int(Sheets(1).Cells(cptr, 1) / 1000)
    Select Case mil
        Case Is = 8
        ranger tab8, n8, cptr
        Case Is = 9
        ranger tab9, n9, cptr
        Case Is = 10
        ranger tab10, n10, cptr
        Case Is = 11
        ranger tab11, n11, cptr
        Case Is = 12
        ranger Tab12, n12, cptr
        '.... jusqu'à 29
    End Select
Next

Application.ScreenUpdating = False
For cptr = 1 To 5 ' ...22?
    tabl = Choose(cptr, tab8, tab9, tab10, tab11, Tab12) '.... jusqu'à Tab29
    If UBound(tabl) > 0 Then
        Sheets(CStr((cptr + 7) * 1000)).Range("A1").Resize(UBound(tabl), 1) = Application.Transpose(tabl)
    End If
Next
MsgBox "rangement dans les feuilles terminé"
End Sub

Sub ranger(tabx, nx, cptrx)
tabx(nx) = Cells(cptrx, 1)
nx = nx + 1
ReDim Preserve tabx(nx)
End Sub



ci joint la maquette
https://www.cjoint.com/?mElqounaxk
Messages postés
12257
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
3 septembre 2021
2 652
Merci Michel_m. Post résolu maintenant.
Messages postés
741
Date d'inscription
lundi 18 mai 2009
Statut
Membre
Dernière intervention
10 janvier 2016
92
Merci Michel_m désolé . . .