Copie de valeurs d'une colonne non identiques

bonsoir,

il remplacer 1 par 2 dans ces instructions

nl = ws.Cells(Rows.Count, 1).End(xlUp).Row ' nl pointeur de dernière ligne utilisée dans CPTU basé sur colonne 1 (=A)

et

ws.Cells(nl, 1) = r.Value ' on met le numéro de sondage en colonne 1 (=A)

et remplacer A par B dans

Set re = ws.Range("A:A").Find(r.Value, lookat:=xlWhole) 'on recherche le n°de sondage dans CPTU

Malheureusement, ça ne marche pas non plus!

Il copie toujours dans la colonne "A".

'CopiePiézomètre Macro

    With Sheets("Coordonnées")
        .Range("$A$4:$N$64").AutoFilter Field:=4, Criteria1:=Array("Z", "FZ", "FSZ"), Operator:=xlFilterValues 'on filtre les données de coordonnées
       Set ws = Sheets("Piézomètres") ' ws = référence de la feuille piézomètre
       nl = ws.Cells(Rows.Count, 2).End(xlUp).Row ' nl pointeur de dernière ligne utilisée dans CPTU basé sur colonne 1 (=A)
       For Each r In .Range(.Range("C5"), .Range("C5").End(xlDown)).SpecialCells(xlVisible) ' on parcourt toutes les cellules sélectionnées de la colonne  C, (r=cellule en cours)
           Set re = ws.Range("b:b").Find(r.Value, lookat:=xlWhole) 'on recherche le n°de sondage dans CPTU
           If re Is Nothing Then 'si non trouvé
               nl = nl + 1 ' on ajoute une nouvelle ligne
               ws.Cells(nl, 1) = r.Value ' on met le numéro de sondage en colonne 1 (=A)
           End If
        Next
    End With

tu as oublié de changer un1 en2 dans l'instruction

ws.Cells(nl, 1) = r.Value ' on met le numéro de sondage en colonne 1 (=A)

voici un code adapté pour toutes tes feuilles.

Sub CopieFeuillets()
' CopieForage Macro
    With Sheets("Coordonnées")
        For i = 1 To 4
        On Error Resume Next
            Erase critères
            On Error GoTo 0
            Select Case i
            Case 1
                wsn = "FORAGE"
                critères = Array("F", "FC", "FS", "FSZ")
                col = "A"
            Case 2
                wsn = "CPTU"
                critères = Array("C", "CR", "FC")
                col = "A"
            Case 3
                wsn = "Piézomètres"
                critères = Array("Z", "FSZ")
                col = "B"
            Case 4
                wsn = "Inclinomètres"
                critères = Array("I")
                col = "B"
            End Select
            .Range("$A$4:$N$64").AutoFilter Field:=4, Criteria1:=critères, Operator:=xlFilterValues         'on filtre les données de coordonnées
            Set ws = Sheets(wsn)    ' ws = référence de la feuille
            nl = ws.Cells(Rows.Count, col).End(xlUp).Row    ' nl pointeur de dernière ligne utilisée dans la feuille basé sur colonne col
            For Each r In .Range(.Range("C5"), .Range("C5").End(xlDown)).SpecialCells(xlVisible)    ' on parcourt toutes les cellules sélectionnées de la colonne  C, (r=cellule en cours)
                Set re = ws.Range(col & ":" & col).Find(r.Value, lookat:=xlWhole)    'on recherche le n°de sondage dans la colonne col
                If re Is Nothing Then    'si non trouvé
                    nl = nl + 1    ' on ajoute une nouvelle ligne
                    ws.Cells(nl, col) = r.Value    ' on met le numéro de sondage en colonne col
                End If
            Next
        Next i
    End With
End Sub

Merci ça marche, mais il y ne copie pas la première valeur de la liste. Il commence toujours par la deuxième valeur, la première valeur apparaît seulement quand je relance la macro.

Est-ce normal?

Merci!

Bonjour,

je revérifié avec le fichier que tu as donné en exemple, je ne parviens pas à reproduire le problème que tu mentionnes.

Bon, ce n'est pas très grave je suis capable de vivre avec! De toutes façon, lorsque je relance la macro, il m'insère le numéro.

Est-ce possible d'ajouter une ligne de commande pour que la macro exécute un tri croissant dans chacune des feuilles?

Merci!

Bonsoir,

voici une proposition qui inclut le tri et corrige le bug que tu as rencontré (enfin je pense)

à toi de vérifier les paramètres des cas 1 à 4

Sub CopieFeuillets()
' CopieForage Macro
    With Sheets("Coordonnées")
        For i = 1 To 4
            On Error Resume Next
            Erase critères
            On Error GoTo 0
            Select Case i
            Case 1
                wsn = "FORAGE"
                critères = Array("F", "FC", "FS", "FSZ")
                col = "A" ' colonne dans laquelle mettre le n° de sondage, est également la colonne pour le tri
                pl = 7 'première ligne des données dans wsn
                tabtri = "A" & pl & ":H" ' tableau à trier
            Case 2
                wsn = "CPTU"
                critères = Array("C", "CR", "FC")
                col = "A"
                pl = 7
                tabtri = "A" & pl & ":H"
            Case 3
                wsn = "Piézomètres"
                critères = Array("Z", "FSZ")
                col = "B"
                pl = 8
                tabtri = "A" & pl & ":H"
            Case 4
                wsn = "Inclinomètres"
                critères = Array("I")
                col = "B"
                pl = 8
                tabtri = "A" & pl & ":H"
            End Select
            .Range("$A$4:$N$64").AutoFilter Field:=4, Criteria1:=critères, Operator:=xlFilterValues         'on filtre les données de coordonnées
            Set ws = Sheets(wsn)    ' ws = référence de la feuille
            nl = ws.Cells(Rows.Count, col).End(xlUp).Row    ' nl pointeur de dernière ligne utilisée dans la feuille basé sur colonne col
            If nl < pl Then nl = pl - 1
            For Each r In .Range(.Range("C5"), .Range("C5").End(xlDown)).SpecialCells(xlVisible)    ' on parcourt toutes les cellules sélectionnées de la colonne  C, (r=cellule en cours)
                Set re = ws.Range(col & ":" & col).Find(r.Value, lookat:=xlWhole)    'on recherche le n°de sondage dans la colonne col
                If re Is Nothing Then    'si non trouvé
                    nl = nl + 1    ' on ajoute une nouvelle ligne
                    ws.Cells(nl, col) = r.Value    ' on met le numéro de sondage en colonne col
                End If
            Next
            With ws.Range(tabtri & nl)
                .Sort key1:=.Cells(1, col), order1:=xlAscending, Header:=xlNo
            End With
        Next i
    End With
End Sub

Merci beaucoup, ça marche vraiment bien!

Je n'y serais pas arrivé seul!!

Juste une petite chose, il garde la touche de filtre active sur ma feuille "Coordonnées". Je sais que je peux l'arrêter en appuyant sur la touche filtre dans la barre de menu mais je veux que ce soit automatique.

Qu'elle est la commande pour qu'il arrête le filtre?

Encore merci de votre aide!

J'ai trouvé un solution à ce problème!

bassmart a écrit :

Juste une petite chose, il garde la touche de filtre active sur ma feuille "Coordonnées". Je sais que je peux l'arrêter en appuyant sur la touche filtre dans la barre de menu mais je veux que ce soit automatique.

Qu'elle est la commande pour qu'il arrête le filtre?

Et voici!

Sub CopieFeuillets()
' Copie Macro

   With Sheets("Coordonnées")
        For i = 1 To 4
            On Error Resume Next
            Erase critères
            On Error GoTo 0
            Select Case i
            Case 1
                wsn = "FORAGE"
                critères = Array("F", "FC", "FS", "FSZ")
                col = "A" ' colonne dans laquelle mettre le n° de sondage, est également la colonne pour le tri
               pl = 8 'première ligne des données dans wsn
               tabtri = "A" & pl & ":H" ' tableau à trier
           Case 2
                wsn = "CPTU"
                critères = Array("C", "CR", "FC")
                col = "A"
                pl = 7
                tabtri = "A" & pl & ":H"
            Case 3
                wsn = "Piézomètres"
                critères = Array("Z", "FSZ")
                col = "B"
                pl = 8
                tabtri = "A" & pl & ":H"
            Case 4
                wsn = "Inclinomètres"
                critères = Array("I")
                col = "B"
                pl = 7
                tabtri = "A" & pl & ":H"
            End Select
            .Range("$A$4:$N$64").AutoFilter Field:=4, Criteria1:=critères, Operator:=xlFilterValues         'on filtre les données de coordonnées
           Set ws = Sheets(wsn)    ' ws = référence de la feuille
           nl = ws.Cells(Rows.Count, col).End(xlUp).Row    ' nl pointeur de dernière ligne utilisée dans la feuille basé sur colonne col
           If nl < pl Then nl = pl - 1
            For Each r In .Range(.Range("C5"), .Range("C5").End(xlDown)).SpecialCells(xlVisible)    ' on parcourt toutes les cellules sélectionnées de la colonne  C, (r=cellule en cours)
               Set re = ws.Range(col & ":" & col).Find(r.Value, lookat:=xlWhole)    'on recherche le n°de sondage dans la colonne col
               If re Is Nothing Then    'si non trouvé
                   nl = nl + 1    ' on ajoute une nouvelle ligne
                   ws.Cells(nl, col) = r.Value    ' on met le numéro de sondage en colonne col
               End If
            Next
            With ws.Range(tabtri & nl)
                .Sort key1:=.Cells(1, col), order1:=xlAscending, Header:=xlNo
            End With
        Next i
        If Worksheets("Coordonnées").AutoFilterMode Then
            Worksheets("Coordonnées").AutoFilterMode = False
        End If
    End With       

End Sub