Discussion :

[BENNASR]

Bonjour et merci d'avance
débutant en VBA mais grace à vous j'avance dans mon ptit projet

je cherche un code qui copie non pas une ligne entière mais que la colonne A / C / E de la feuil1 vers les colonne A/B/C (dans l'ordre) de la feuil2 si la date figurant dans la colonne A de la feuil1 est inférieur à une date saisie dans feuil2 J5
j’espère être claire et merci encore

[Invité]

Bonjour,
regarde du coté des filtre élaboré ou filtre actif :http://www.developpez.net/forums/d13...s/#post7481714

[tamtam64]

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
Sub test2()
    Dim xlsheet As Worksheet
    Dim xlsheet2 As Worksheet
    Dim AllRange As Range
    Dim MyRange As Range
    Dim i As Long
    Dim NbL As Long
        'definition des feuilles
    Set xlsheet = ThisWorkbook.Worksheets("Feuil1")
    Set xlsheet2 = ThisWorkbook.Worksheets("Feuil2")
        'parcour du range et copie avec condition
    With xlsheet
        NbL = .Range("A1").End(xlDown).Row
        Set AllRange = Application.Union(Range("A" & NbL), Range("C" & NbL), Range("E" & NbL))
        For Each MyRange In AllRange.Columns(1).Cells
            i = i + 1
            If MyRange.Value < xlsheet.Range("J5").Value Then
                .Range(MyRange, MyRange.Offset(, 2)).Copy xlsheet2.Range("A" & i + 1)
            End If
        Next MyRange
    End With
End Sub

jJe sais pas si ca fait exactement ce que tu veux mais ca parcour tes valeurs ert ca copie la ligne si c'est inferieur a la valeur de J5

[BENNASR]

bonjour la forum, merci tamtam, ....
sur internet j'ai arrivé a adapté partiellement ce code

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
Sub GRAND_LIVRE()
 
 Dim plage As Range, cel As Range
 
    Application.ScreenUpdating = False
    valcherch = Sheets("EDITION").Range("B5")
    With Worksheets("Mouvement")
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        Set plage = .Range("A11:A" & derlig)
    End With
 
    For Each cel In plage
        If cel = valcherch Then
            cel.EntireRow.copy
            Worksheets("EDITION").Range("A13").Select
            Selection.Insert Shift:=xlDown
        End If
    Next cel
    Application.ScreenUpdating = True
End Sub

ce code copie toute la ligne entière et moi je veux copie une partie de la ligne de la feuil "mouvement" à la feuil "edition" : c'est le (B E G H)
De même je souhaite si je peux ajouter la condition suivante :
le champs "B" de la feuil "Mouvement" qui est une date doit être comprise entre "B6" date départ et "B7" date fin de la feuil "EDITION"
Merci d'avance et bonne et heureuse journée

ce cesse pas de tenter et j'ai arriver à ca mais il prend bq de temps !!!
aussi il ne commence pas à partir de la ligne 13 de la feuille "edition" !! il commence de la ligne 14 !!
Aussi à l'ordre inverse de ma feuille "Mouvement"

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
Sub GRAND_LIVRE()
 
 Dim plage As Range, cel As Range
    Application.ScreenUpdating = False
    valcherch = Sheets("EDITION").Range("B5")
    With Worksheets("Mouvement")
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        Set plage = .Range("A11:A" & derlig)
    End With
 
    For Each cel In plage
        If cel = valcherch Then
        cel(, 2).copy Worksheets("EDITION").Range("A13")
        cel(, 5).copy Worksheets("EDITION").Range("B13")
        cel(, 7).copy Worksheets("EDITION").Range("C13")
        cel(, 8).copy Worksheets("EDITION").Range("D13")
 
        Worksheets("EDITION").Range("A13").Select
        Selection.Insert Shift:=xlDown
        Worksheets("EDITION").Range("B13").Select
        Selection.Insert Shift:=xlDown
        Worksheets("EDITION").Range("c13").Select
        Selection.Insert Shift:=xlDown
        Worksheets("EDITION").Range("D13").Select
        Selection.Insert Shift:=xlDown
        End If
 
    Next cel
    Application.ScreenUpdating = True
End Sub

je vous attends svp ... bonne fin journée

[BENNASR]

chui coincé
et depuis hier j'ai rien reçu... pas comme d'habitude... j'ai pas de chance ds ce sujet