Discussion :

[nacereddine mourad]

Bonjour;

En choisissant l'année et le mois avec deux ComboBox (1 et 2) sur un UserForm1,

je voudrais copier les lignes de la feuille "pointage" colonne [A;P] et les coller dans la feuille "charges_personnel" colonne [C;R],

en tenant compte de (critère 1 ) l'année, (critère 2 ) le mois et (critère 3 ) les "Non soldé" de la colonne [J] de la feuille "pointage",

juste une petite remarque ; les lignes copier doivent changer de Situation salaire : de "Non soldé" a "soldé" dans les deux feuille, colonne [J] de la feuille "pointage" et colonne [L] de la feuille "charges_personnel",

tout en appuyant sur le CommandButton5

merci pour votre attention, salutation.

[EricDgn]

Bonjour,

Une façon de faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
 
Sub FiltrerCopier(sAn As String, sMois As String)
    Dim kR As Long, kC As Long, kCp As Long, rP As Range
    With Range("charges_personnel")
        If .Rows.Count = 1 Then     '--- tableau vide (uniquement ligne des titres)
            kR = .Row
        Else
            kR = .Rows.Count + .Row
        End If
        kC = .Column + 2
    End With
    With Worksheets("pointage").ListObjects("pointage").DataBodyRange
        .AutoFilter
        kCp = .Column - 1
        .AutoFilter Field:=Range("pointage[Année]").Column - kCp, Criteria1:=sAn
        .AutoFilter Field:=Range("pointage[Mois]").Column - kCp, Criteria1:=sMois
        .AutoFilter Field:=Range("pointage[Situation salaire]").Column - kCp, Criteria1:="Non soldé"
        On Error Resume Next        '--- erreur si aucune ligne en résultat
        Set rP = Range("pointage[[Code personnel]:[Congé]]").SpecialCells(xlCellTypeVisible)
        If Err.Number = 0 Then
            rP.Replace What:="Non soldé", Replacement:="Soldé", LookAt:=xlWhole
            rP.Copy Sheets("charges_personnel").Cells(kR, kC)
        Else
            Err.Clear
        End If
        On Error GoTo 0
        .AutoFilter
    End With
    Application.CutCopyMode = False
End Sub

Cordialement.

[nacereddine mourad]

Bonjour et merci EricDgn, merci , est il possible de coller en format valeur non en forma formule?

je voudrais apporté quelques modifications sur la procédure de coller les données sur la feuille "charges_personnel"

l'idéal est d'incrémenter les colonnes A et B de la feuille "charges_personnel" comme ci-dessous

colonne A	colonne B
1	CHAR-PER-001
2	CHAR-PER-002

Ci-jointe, le nouveau classeur

merci.

[EricDgn]

Bonjour,

Ceci devrait le faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub FiltrerCopier(sAn As String, sMois As String)
    Dim kR As Long, kC As Long, kCp As Long, rP As Range
    Dim nR As Long, i As Long, NewID As Long
    With Range("charges_personnel")
        If .Cells(1, 3) = "" Then  '--- tableau vide (uniquement ligne des titres)
            kR = .Row
            nR = 0
            NewID = 1
        Else
            kR = .Rows.Count + .Row
            nR = Range("charges_personnel").Rows.Count  '--- nombre de lignes avant ajout copie
            NewID = .Cells(.Rows.Count, 1) + 1
        End If
        kC = .Column + 2
        Debug.Print kR, kC, nR, NewID
    End With
    With Worksheets("pointage").ListObjects("pointage").DataBodyRange
        .AutoFilter
        kCp = .Column - 1
        .AutoFilter Field:=Range("pointage[Année]").Column - kCp, Criteria1:=sAn
        .AutoFilter Field:=Range("pointage[Mois]").Column - kCp, Criteria1:=sMois
        .AutoFilter Field:=Range("pointage[Situation salaire]").Column - kCp, Criteria1:="Non soldé"
        On Error Resume Next        '--- erreur si aucune ligne en résultat
        Set rP = Range("pointage[[Code personnel]:[Congé]]").SpecialCells(xlCellTypeVisible)
        If Err.Number = 0 Then
            rP.Replace What:="Non soldé", Replacement:="Soldé", LookAt:=xlWhole
            'rP.Copy Sheets("charges_personnel").Cells(kR, kC)
            rP.Copy
            Sheets("charges_personnel").Cells(kR, kC).PasteSpecial Paste:=xlPasteValues
            nR = Range("charges_personnel").Rows.Count - nR     '--- nombre de lignes ajoutées par la copie
            With Sheets("charges_personnel")
                For i = 1 To nR
                    .Cells(kR - 1 + i, kC - 2) = NewID
                    .Cells(kR - 1 + i, kC - 1) = "CHAR-PER-" & Format(NewID, "000")
                    NewID = NewID + 1
                Next i
            End With
        Else
            Err.Clear
        End If
        On Error GoTo 0
        .AutoFilter
    End With
    Application.CutCopyMode = False
End Sub

Cordialement.

[nacereddine mourad]

bonjour, merci infiniment EricDgn, c'est parfait