Macro excel triage et copie de nombre Résolu

Question

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

pijaku · Answer

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"...

informatifien · Answer

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

pijaku · Answer

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?

informatifien · Answer

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

informatifien · Answer

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 ;)

informatifien · Answer

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

michel_m · Answer

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

informatifien · Answer

Merci Michel_m désolé . . .

Macro excel triage et copie de nombre

8 réponses

Newsletters