recherche, tri et copie de données

[bogs]

bonjour à tous,

je cherche la petite macro qui va bien :
j'ai une feuille base de données.
à partir de cette feuille je veux faire des extractions de valeurs vers d'autres feuilles, littéralement si dans la colonne 'd' on voit la lettre 'x' les lignes concernées doivent être recopiées dans une autre feuille.
le probleme que j'ai, c'est que je fais ensuite des recherchev dans chaque feuille pour renseigner une feuille de saisie. la macro que j'ai, recopie l'intégralité des lignes et mes recherches deviennent vite farfelues ou plutot 'décalées'
je souhaite donc une macro qui recopie la ligne entière à l'exception de la premiere colonne qui dans chaque feuille ne doit pas être utilisée.
merci pour vos reponses....

 

[ChTi160]

Salut Bogs
pour plus de compréhension peux tu mettre un extrait de ton fichier et la réprésentation de centce que tu désirs(Fichier Zip-50K pas de caractere speciaux ni accent
Amicalement
Jean marie

 

[bertrand]

bonjour,

je n'ai pas tout compris mais je pense que tu devrais t'orienter vers les filtres élaborés qui te permettront d'extraire vers une autre feuille suivant des critères donnés.

@+

 

[bogs]

ci joint un exemple de fichier avec en feuille 2et 3 les extraction que je veux faire.merci. [file name=classeur1_20050425112118.zip size=4727]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/classeur1_20050425112118.zip[/file]

 

[porcinet82]

salut bogs,

bon je crois que je viens de réaliser la macro qui va bien, enfin ca c'est toi qui me le dira apres l'avoir testé.

elle fait ce que tu avais mis en exemple. elle pourrait etre plus courte mais j'ai fait ca rapidement donc...

Sub classement()
j = 2
l = 2
Sheets('base_de_donnees').Select
Range('D2').Select
For i = 1 To Range('D65536').End(xlUp).Row
    Range('D' & j).Select
    If ActiveCell.Value = 'x' Then
        Range('B' & j & ':' & 'C' & j).Select
        Selection.Copy
        Sheets('viry').Select
        Range('B2').Select
line1:
        If ActiveCell.Value = '' Then
            ActiveSheet.Paste
            Selection.Offset(1, 0).Select
        Else
            Selection.Offset(1, 0).Select
            GoTo line1
        End If
    Else
        Selection.Offset(1, 0).Select
    End If
    j = j + 1
    Sheets('base_de_donnees').Select
Next i

For k = 1 To Range('E65536').End(xlUp).Row
    Range('E' & l).Select
    If ActiveCell.Value = 'x' Then
        Range('B' & l & ':' & 'C' & l).Select
        Selection.Copy
        Sheets('melun').Select
        Range('B2').Select
line2:
        If ActiveCell.Value = '' Then
            ActiveSheet.Paste
            Selection.Offset(1, 0).Select
        Else
            Selection.Offset(1, 0).Select
            GoTo line2
        End If
    Else
        Selection.Offset(1, 0).Select
    End If
    l = l + 1
    Sheets('base_de_donnees').Select
Next k
End Sub

voila bon courage

@+

 

[ChTi160]

Salut bogs
Salut porcinet82,bertrand
je viens de me raendre compte que j'ai oublié de t'en oyer ma petite contribution c'est fou je ne sais plus ou j'en suis lol
en pièce jointe une possibilité
Amicalement
Jean Marie
[file name=Recherche_Tri_Copie.zip size=12359]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Recherche_Tri_Copie.zip[/file]

 

[ChTi160]

Re bogs et porcinet82
porcinet82 je me suis permi de modifier ton code,
afin d'en améliorer l'efficacité je n'ai rien enlevé Lol
je tiens aussi à te signalé, si celà n'a pas déjà été fait par thierry qu'il est vivement recommendé de déclarer les différentes variables qui sont utilisées dans une procèdure
celà n'est qu'un conseil de petit qui a lui aussi , en sont temps eu cette recommandation lol
donc bogs aura deux solutions
Sub classement()
Application.ScreenUpdating = False
Sheets('melun').Cells.ClearContents
Sheets('viry').Cells.ClearContents
j = 2
L = 2
With Sheets('base de donnees')
.Select
Source = .Range('A1:C1')
Sheets('melun').Range('B11') = Source
Sheets('viry').Range('B11') = Source
End With
Range('D2').Select
For i = 1 To Range('D65536').End(xlUp).Row
Range('D' & j).Select
If ActiveCell.Value = 'x' Then
Range('A' & j & ':' & 'C' & j).Select
Selection.Copy
With Sheets('viry')
.Select
.Range('B2').Select
End With
line1:
If ActiveCell.Value = '' Then
ActiveSheet.Paste
Selection.Offset(1, 0).Select
Else
Selection.Offset(1, 0).Select
GoTo line1
End If
Else
Selection.Offset(1, 0).Select
End If
j = j + 1
Sheets('base de donnees').Select
Next i

For k = 1 To Range('E65536').End(xlUp).Row
Range('E' & L).Select
If ActiveCell.Value = 'x' Then
Range('A' & L & ':' & 'C' & L).Select
Selection.Copy
Sheets('melun').Select
Range('B2').Select
line2:
If ActiveCell.Value = '' Then
ActiveSheet.Paste
Selection.Offset(1, 0).Select
Else
Selection.Offset(1, 0).Select
GoTo line2
End If
Else
Selection.Offset(1, 0).Select
End If
L = L + 1
Sheets('base de donnees').Select
Application.CutCopyMode = False
Next k
Application.ScreenUpdating = True
End Sub

Amicalement
Jean Marie

 

[porcinet82]

salut jean-Marie,

c'est vrai que tu as entierement raison a propos des déclaration des variables, mais comme c pas obligatoire, et étatn débutant, je ne commence que maintenant a m'en préoccuper.

disons qu'au début tant que ca fonctionne on ne se pose pas de question, mais c'est vrai que qu'en progressant, on s'apercoit que ca peux effectivement servir.

donc sur la prochaine macro que je proposerai sur le forum, j'essaierai de tenir compte de tes conseils.

sinon une petite question, a quoi sert cette ligne de code:

Application.ScreenUpdating = False

et d'ailleur a quoi sert également celle de la fin (mais =True)

en te remerciant d'avance et au plaisir de te recroiser sur le forum

@+

 

[ChTi160]

re porcinet82
le code
Application.ScreenUpdating = False
inhibe le défilement des fenetres en cas de sélections multiples et différentes ,si tu passes d'une feuille à l'autre ou de cellule en cellule tu as directement le final si on peut dire
c'est plus une question de confort de visualisation
tu fais l'essai tu isoles ces deux lignes et tu lances la macro
et
Application.ScreenUpdating = True
remet le défilement des fênetres
ce n'est pas une leçon mais la transmission de ce que j'apprends sur ce Forum
Amicalement
Jean Marie

 

[porcinet82]

salut JM,

je te remercie de ta reponse, bonne journée a toutes et a tous

porcinet

 

[_RV]

salut tout le monde,

j'arrive peut-être un peu tard, mais ce code marche pas mal du tout:

Option Explicit
Option Base 1

Const ColàScanner As Byte = 5 '<= Soit la colonne 'E' par exemple...

Sub Trieur()

Dim PlageSource As Variant
Dim PlageCible() As Variant
Dim i As Long, x As Long
Dim NbCol As Byte
Dim C As Byte
x = 1

With ActiveSheet
NbCol = .Range('A1').End(xlToRight).Column
PlageSource = .Range(Cells(1, 1), Cells(.Range('A65536').End(xlUp).Row, NbCol))
End With

For i = 1 To UBound(PlageSource)
If Mid(PlageSource(i, ColàScanner), 3, 1) = 'x' Then 'en gros, si le 3e caractère de la colonne à vérifier est 'x'
ReDim Preserve PlageCible(UBound(PlageSource), NbCol)
For C = 1 To NbCol
PlageCible(x, C) = PlageSource(i, C)
Next
x = x + 1
End If
Next i

Worksheets.Add 'Ici je crée un nouvelle feuille à la volée
Range(Cells(1, 2), Cells(x, NbCol + 1)) = PlageCible

end sub


c'est un vieux code que _thierry m'avait aidé à faire (enfin c'était surtout lui hein...)


a++ tout le monde

Hervé.

 

[ChTi160]

Salut RV
il n'est jamais trop tard pour bien faire
moi je vais tester ça
ce n'est pas tout à fait ce que recherche porcinet82
mais il est bon de diversifier
donc merci pour ce code
Bonne fin de Journée
Amicalement
Jean Marie