Copier donner selon condition

[René du var]

Bonsoir le forum,

J'aimerai pourvoir automatiser une tâche !

Je joint un fichier pour plus de clartée

Je résume la condition de la formule ou de la macro :

Dans le claseur il y a 5 onglets pricipaux

BX
CP
CF
SG
BDD TEXTE PAYE

La formule ou la macro doit interroger la colonne 'd' de l'onglet BDD TEXTE PAYE, si elle trouve 'bx' alors il faut copier toutes les lignes contenant 'bx' dans l'onglet BX etc......

[file name=test_20051115183548.zip size=27697]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20051115183548.zip[/file]

 

[andré]

Salut rené,

Un essai en pièce jointe.

La petite liste de validation en A1 te permet de choisir la feuille de copie.

Â+

OUPS !

Vaut mieux écrire René sans é ! [file name=test_Rene.zip size=45724]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_Rene.zip[/file]

Message édité par: andré, à: 15/11/2005 19:46

 

[Hellboy]

Bonjour René du var

Voici une proposition:

Private Sub CommandButton1_Click()
    Dim bytCritere        As Byte
    Dim strCritere        As String
   
    Application.ScreenUpdating = False
    For bytCritere = 2 To 5
            Select Case bytCritere
                            Case 2:    strCritere = 'BX'
                            Case 3:    strCritere = 'CF'
                            Case 4:    strCritere = 'CP'
                            Case 5:    strCritere = 'SG'
            End Select
            Cells(1, 4).AutoFilter Field:=1, Criteria1:=strCritere
            Range(Cells(2, 1), Selection.SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Select
            If Selection.Row > 1 Then
                    Selection.Copy
                    With Sheets(bytCritere)
                            .Select
                            .Cells(65536, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                            True, Transpose:=False
                    End With
                    Sheets(1).Select
            End If
    Next bytCritere
    Cells(1, 4).AutoFilter Field:=1
    Cells(1, 1).Select
    Application.ScreenUpdating = True
End Sub

[file name=test_20051115195230.zip size=40332]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20051115195230.zip[/file]

Oopss, c'est a mon tour André, désolé ! 😱

Message édité par: Hellboy, à: 15/11/2005 19:53

 

[Robert]

Bonsoir René, Ândré, Hellboy, bonsoir le forum,

Dur dur de passer derrière les cracks de ce forum. Tant pis, je t'envoie ma proposition quand même... Essaie cette macro :

Sub Macro1()
Dim cel As Range 'déclare la variable Cel
Dim Dest As Range 'déclare la variable Dest

With Sheets('BDD TEXTE PAYE') 'prend en compte l'onglet 'BDD TEXTE PAYE'

'boucle sur toutes les cellule Cel éditées de la colonne D
For Each cel In .Range('D1😀' & .Range('D65536').End(xlUp).Row)

'définit la destination de la copie
'condition si la cellule A1 de l'onglet de destination est vide
If Sheets(cel.Value).Range('A1').Value = '' Then
'définit la variable Dest
Set Dest = Sheets(cel.Value).Range('A1')
'copie la largeur de la colonne
cel.EntireRow.Copy
Dest.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Else 'sinon
'définit la variable Dest
Set Dest = Sheets(cel.Value).Range('A65536').End(xlUp).Offset(1, 0)
End If 'fin de la condition

'copie et colle la ligne dans la destination
cel.EntireRow.Copy Destination:=Dest
Next cel 'prochaine cellule éditée de la colonne D

End With 'fin de la prise en compte de l'onglet 'BDD TEXTE PAYE'
End Sub

 

[René du var]

Merci pour ta réponse

Il y a un problème car les quatre onglet doivent garder le meme aspect sans ajouter de colonne sionon ca fausse tout pour le reste de mon travail

 

[René du var]

Scuse j'ai oublié de préciser que le message s'adresse à Barbatruc

 

[René du var]

merci Accro,

bien vu mais ca plante à ce niveau chez moi!

Cells(1, 4).AutoFilter Field:=1, Criteria1:=strCritere

par contre serait-il possible de ne pas mettre de filtre ?

René du var

 

[Robert]

Bonsoir le fil, bonsoir le forum,

René je suis mort de rire car tu confonds le dégré d'implication dans le site et le Pseudo de la personne. Ainsi Ândré devient Barbatruc (remarque ça lui va si bien...) et Hellboy devient Accro... Le nom est écrit au dessus Visiteur, au dessus...

 

[René du var]

Merci Robert

Comme je l'ai dis au dessus il faut pas de filtre et je veux garder la meme structure de fichier et remplis les 4 onglets bx cp cf sg en meme temps



Dest.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

 

[René du var]

Merci pour la remarque je viens de le voir lol

je suis tellement dans le fichier du coup j'ai pas fais gaffe

René du var

 

[Hellboy]

Bonjour René du var

Je te propose la même solution, mais sans que tu t'aperçoive que j'ai utilisé le filtre.


[file name=test_20051116005613.zip size=41608]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20051116005613.zip[/file]

 

[René du var]

Merci pour la réponse

Mais pourquoi ca ne marche pas chez moi ?

ca s'arrete sur cette ligne :

Columns('D😀').AutoFilter

j'ai EXCEL 97

René du var

 

[Hellboy]

re René du var

J'essaie cette nouvelle tentative, mais je ne garanti rien car je n'ai pas Excel 97.


[file name=test_20051116104556.zip size=44591]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/test_20051116104556.zip[/file]

 

[René du var]

Bonjour

Non ca ne marche pas toujours un blocage à ce niveau

Columns('D😀').AutoFilter

c'est surement la version d'excel qui colle pas

merci

René du var

 

[Robert]

Bonjour le fil, bonjour le forum,

René, j'ai l'air de vouloir prêcher pour ma paroisse... mais as-tu essayé la solution que je te proposais (sans filtre comme les gitanes maïs). Si c'est l'actualisation de la largeur des colonnes qui te gêne, voici le code modifié :

Sub Macro1()
Dim cel As Range 'déclare la variable Cel
Dim Dest As Range 'déclare la variable Dest

With Sheets('BDD TEXTE PAYE') 'prend en compte l'onglet 'BDD TEXTE PAYE'

'boucle sur toutes les cellule Cel éditées de la colonne D
For Each cel In .Range('D1😀' & .Range('D65536').End(xlUp).Row)

'définit la destination de la copie
'condition si la cellule A1 de l'onglet de destination est vide
If Sheets(cel.Value).Range('A1').Value = '' Then
'définit la variable Dest
Set Dest = Sheets(cel.Value).Range('A1')
Else 'sinon
'définit la variable Dest
Set Dest = Sheets(cel.Value).Range('A65536').End(xlUp).Offset(1, 0)
End If 'fin de la condition

'copie et colle la ligne dans la destination
cel.EntireRow.Copy Destination:=Dest
Next cel 'prochaine cellule éditée de la colonne D

End With 'fin de la prise en compte de l'onglet 'BDD TEXTE PAYE'
End Sub