Ameliorer code VBA

Bonjour à toutes et à tous

J'ai trouver le code suivant qui me permet d'importer les valeurs des cellules d'un tableau vers un autre,

en triant en fonction d'un critère de champs.

.Range("$A$3:$U$103").AutoFilter Field:=6, Criteria1:="VTT"
    .Range("A4:D104").Copy
        Sheets("Paraphes").Range("AW11").PasteSpecial Paste:=xlPasteValues
    .Range("J4:J104").Copy
        Sheets("Paraphes").Range("AZ11").PasteSpecial Paste:=xlPasteValues

le problème est que si dans

"critérial

" il n'y a pas "VTT" par exemple alors le code importe tout le tableau.

est il possible de mettre une condition "if then" qui permettrait de garde la fiche vierge en cas d'absence d'un critère ?

Merci d'avance pour votre aide.

Bonjour,

Merci de joindre un fichier à ta demande.

Cdlt.

Bonjour Jean Eric

Je te joins l'adresse du fichier :

Le problème est sur la feuille "paraphes"," useform2" ,bouton de commande "paraphes".

Amicalement

Bernard

Bonjour,

Pour le principe :

'Complète les feuilles pour paraphes des coureurs
Private Sub Paraphes_Click()
Dim ws As Worksheet, ws2 As Worksheet
Dim rng As Range, rng2 As Range

    Application.ScreenUpdating = False

    Set ws = ActiveWorkbook.Worksheets("Engag?s")
    Set ws2 = ActiveWorkbook.Worksheets("Paraphes")

    With ws
        If .FilterMode Then .ShowAllData
        Set rng = .Range("$A$3:$U$103")
        '1?re
        rng.AutoFilter Field:=6, Criteria1:="1?re"
        With .AutoFilter.Range
            On Error Resume Next
            Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                       .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rng2 Is Nothing Then
                rng2.Resize(, 4).Copy
                ws2.Cells(11, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                rng2.Offset(, 9).Copy
                ws2.Cells(11, 5).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                Application.CutCopyMode = False
            End If
        End With
        '2?me.
        rng.AutoFilter Field:=6, Criteria1:="2?me"
        With .AutoFilter.Range
            On Error Resume Next
            Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
                       .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not rng2 Is Nothing Then
                rng2.Resize(, 4).Copy
                ws2.Cells(11, 9).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                rng2.Offset(, 9).Copy
                ws2.Cells(11, 13).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                Application.CutCopyMode = False
            End If
        End With
        .AutoFilterMode = False
    End With
    Unload Me
End Sub

Merci pour ton aide

J'ai essayé ton code.

Il fonctionne jusqu'au 2ème,

Mais à partir du 3ème j'ai erreur 1004 "erreur défini par l'application ou par l'objet

et le ligne

 rng2.Resize(, 4).Copy

est surlignée.

Je joins le code pour les 3ème caté.

'3?me.

rng.AutoFilter Field:=6, Criteria1:="3?me"

With .AutoFilter.Range

On Error Resume Next

Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _

.SpecialCells(xlCellTypeVisible)

On Error GoTo 0

If Not rng2 Is Nothing Then

rng2.Resize(, 4).Copy

ws2.Cells(11, 17).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

rng2.Offset(, 9).Copy

ws2.Cells(11, 21).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Application.CutCopyMode = False

End If

End With

encore merci pour ton aide.

A te relire

Re,

J'ai fait pour les 2 premiers items.

Tu dois reproduire la chose pour les autres items !...

Cdlt.

re

C'est ce qu j'ai essayé, mis je ne comprend pas l'erreur 1004.

J'ai bien modifier les n° de cellule , mais pourquoi la ligne

rng2.Resize(, 4).Copy

est elle surlignée en jaune ?

D'avance merci

Re,

Envoie ton classeur avec la procédure que tu as mise à jour.

Que je voie !...

Chaque erreur te sera facturée 10 EUR.

Cdlt.

Waouh dur dur

Voici l'adresse

: HLql0GXG6Or_Classement-Cyclo-Cross-Rév-6-1travail-.xlsm

Re,

Je pense que le Homard et le caviar seront sur ma table pour les fêtes !...

Je peux par MP te communiquer mes coordonnées bancaires.

A te relire.

il y ne a tant que cela ?

Re

J'ai trouvé l'origine du problème,

cela vient du fait que sur les 3ème caté, il y a une ligne vide.

Il suffit que la colonne catégorie soit complétée et le code fonctionne.

J'économise le caviar et le homard.

Amicalement

Je clos le post

Rechercher des sujets similaires à "ameliorer code vba"