Discussion :

[manu900]

Bonjour à tous,

Je vous sollicite une nouvelle fois car j'ai besoins de votre aide pour résoudre un petit problème.

J'ai crée un code qui copie les données d'une feuille ("Test") par rapport à la date du jour vers une autre feuille (CopieTest).

Mais voilà, j'aurais aimé que ce code copie le contenu de l'ensemble des feuilles par rapport à la semaine en cour.
C'est à dire que actuellement nous sommes semaine 27, et j'aurai aimé copier le contenu des feuilles du 02-07-2012, 03-07-2012, 04-07-2012, 05-07-2012, 06-07-2012.

Vous trouverez ci-joint les fichiers pour cette exemple et ci-dessous les lignes de 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
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit
Sub Copie()
 
Dim Wbk As Workbook
Dim Ws As Worksheet
Dim Chemin As String
Dim ligne As Long
Dim I As Integer
 
Application.ScreenUpdating = False
Chemin = "C:\CopieTest.xlsx"
If Dir(Chemin) <> "" Then
    Set Wbk = Workbooks.Open(Filename:=Chemin, UpdateLinks:=False)
 
    With Wbk.Worksheets(1)
 
    ligne = .Cells(.Rows.Count, "A").End(xlUp).Row      'supprime les données du jour
      For I = ligne To 1 Step -1
      If Cells(I, 1).Value = Date Then
       Cells(I, 1).EntireRow.Delete
    End If
 
    Next I
 
        For Each Ws In ThisWorkbook.Worksheets      'copie les données du jour
 
            If Ws.Name = Format(Date, "dd-mm-yyyy") Then    'recherche les onglets avec la date du jour
               ligne = Ws.Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
                Ws.Range("A1:B" & ligne).Copy
                .Range("A1").Insert Shift:=xlDown
 
                End If
        Next Ws
    End With
 
    'Wbk.Close True
    Set Wbk = Nothing
 
Else
    MsgBox "Fichier " & Chemin & " inexistant"
End If
End Sub

Test.xlsx
CopieTest.xlsx

Merci beaucoup pour votre aide.

Bonne journée

[Daniel.C]

Bonjour,

Je n'ai testé que la partie "date" :

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
Sub Copie()
 
Dim Wbk As Workbook
Dim Ws As Worksheet
Dim Chemin As String
Dim ligne As Long
Dim I As Integer
Dim JourSem As Integer
 
Application.ScreenUpdating = False
Chemin = "C:\CopieTest.xlsx"
If Dir(Chemin) <> "" Then
    Set Wbk = Workbooks.Open(Filename:=Chemin, UpdateLinks:=False)
 
    With Wbk.Worksheets(1)
 
        ligne = .Cells(.Rows.Count, "A").End(xlUp).Row      'supprime les données du jour
          For I = ligne To 1 Step -1
          If Cells(I, 1).Value = Date Then
           Cells(I, 1).EntireRow.Delete
        End If
 
        Next I
 
        JourSem = Application.Weekday(Date, 2)
        For Each Ws In ThisWorkbook.Worksheets      'copie les données du jour
            For I = 1 To 5
                If Ws.Name = Format(Date - JourSem + I, "dd-mm-yyyy") Then    'recherche les onglets avec la date du jour
                   ligne = Ws.Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
                    Ws.Range("A1:B" & ligne).Copy
                    .Range("A1").Insert Shift:=xlDown
                End If
            Next I
        Next Ws
    End With
 
    'Wbk.Close True
    Set Wbk = Nothing
 
Else
    MsgBox "Fichier " & Chemin & " inexistant"
End If
End Sub

[manu900]

Bonjour Daniel.C,

Merci beaucoup pour ta réponse, cela fonctionne parfaitement. J'ai également réussi la fonction "date".
Toutefois, je voulais savoir si il était possible que la copie des données se fasse de façon décroissante, c'est à dire la date la plus grande jusqu'a la plus petite.
De plus, que signie le chiffre "2" sur cette ligne de code : JourSem = Application.Weekday(Date, 2)

Pour ceux que cela intéresse, voici la ligne de code avec la fonction "date"

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
46
47
48
49
Option Explicit
Sub Copie()
 
Dim Wbk As Workbook
Dim Ws As Worksheet
Dim Chemin As String
Dim ligne As Long
Dim I As Integer
Dim N As Integer
Dim JourSem As Integer
 
 
Application.ScreenUpdating = False
Chemin = "C:\CopieTest.xlsx"
If Dir(Chemin) <> "" Then
    Set Wbk = Workbooks.Open(Filename:=Chemin, UpdateLinks:=False)
 
    With Wbk.Worksheets(1)
    JourSem = Application.Weekday(Date, 2)
    ligne = .Cells(.Rows.Count, "A").End(xlUp).Row      'supprime les données du jour
      For I = ligne To 1 Step -1
        For N = 1 To 5
          If Cells(I, 1).Value = Date - JourSem + N Then
       Cells(I, 1).EntireRow.Delete
    End If
     Next N
    Next I
 
 
        JourSem = Application.Weekday(Date, 2)
        For Each Ws In ThisWorkbook.Worksheets      'copie les données du jour
            For I = 1 To 5
            If Ws.Name = Format(Date - JourSem + I, "dd-mm-yyyy") Then  'recherche les onglets avec la date du jour
               ligne = Ws.Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
                Ws.Range("A1:B" & ligne).Copy
                .Range("A1").Insert Shift:=xlDown
 
                End If
                Next I
        Next Ws
    End With
 
    'Wbk.Close True
    Set Wbk = Nothing
 
Else
    MsgBox "Fichier " & Chemin & " inexistant"
End If
End Sub

Merci encore Daniel.

Cordialement

[Daniel.C]

De plus, que signie le chiffre "2" sur cette ligne de code : JourSem = Application.Weekday(Date, 2)

"WeekDay" est la transcription VBA de la fonction Excel JOURSEM. Le paramètre "2" signifie que le premier jour de la semaine est le lundi.
Sinon, pour avoir les feuilles du vendredi au lundi, remplace :

Code :

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

For I = 1 To 5

par :

Code :

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

For I = 5 To 1

[manu900]

Merci Daniel pour la précision sur le "Weekday".

Cela ne fonctionne pas en modifiant la ligne :

For I = 5 to 1

Rien ne ce copie sur la feuille copie test.

Merci

Cordialement.

[fring]

Code :

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

For I = 5 To 1

Bonjour,

Dans ce cas il faut préciser le "pas"

Code :

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

For I = 5 To 1 Step -1

[manu900]

Bonjour fring,

Sa ne marche pas non plus, les dates sont toujours dans l'ordre croissant.

Merci

Cordialement