Discussion :

[manu900]

Bonjour à tous,

J'ai posté il y a quelque temps un problème pour copier le contenu des feuilles qui appartienent aux jours de la semaine.

Mais voilà, si je n'ai qu'une feuille avec une date de la semaine il me copie les données 5 fois. Je souhaite donc que pendant la boucle il passe au jour suivant si la feuille n'existe pas. J'ai essayé de faire cette manip sans grande réussite.

Code :

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

1
2
3
4
5
6
7
8
9
10
For I = 1 To 5    'copie les données de la semaine
 
    Set Ws = ThisWorkbook.Worksheets(Format(Date - JourSem + I, "dd-mm-yyyy"))
        If Not existe(Ws) Then      'ligne ajoutée
            Next I                      'ligne ajoutée
                End If                       'ligne ajoutée
    ligne = Ws.Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
    Ws.Range("A1:B" & ligne).Copy
    .Range("A1").Insert Shift:=xlDown
Next I

Merci encore pour vos réponses.

Bonne journée.

Cordialement

[Daniel.C]

Bonjour,

Adapte :

Code :

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

1
2
3
4
5
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Sheets("f")
    If ws Is Nothing Then MsgBox "toto"
    On Error GoTo 0

[manu900]

Bonjour Daniel,

Merci encore pour ta réponse, cela ne fonctionne pas. La macro me copie 5 fois les données de la seule date de semaine.
Je te joint les fichiers de la semaine dernière ainsi que le 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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
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
Dim plage As Range
 
 
Application.ScreenUpdating = False
Chemin = "C:\CopieTest.xlsx"
If Dir(Chemin) <> "" Then
    Set Wbk = Workbooks.Open(Filename:=Chemin, UpdateLinks:=False)
 
    With Wbk.Worksheets(1)                              ''supprime les données des dates de la semaine
 
    Application.ScreenUpdating = False
    'Set Wbk = ActiveWorkbook
        .Rows(1).Insert
        .[A1] = "bidon"
        .AutoFilterMode = False
        Set plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
        plage.AutoFilter 1, Format(Date, "dd/mm/yyyy")
 
        Set plage = plage.Offset(1).Resize(plage.Rows.Count - 1)
 
        If Application.Subtotal(103, plage) > 0 Then
            Set plage = plage.SpecialCells(xlCellTypeVisible)
            plage.EntireRow.Delete
            .AutoFilterMode = False
        .Rows(1).Delete
        Else
        .AutoFilterMode = False
        .Rows(1).Delete
        End If
 
 
 JourSem = Application.Weekday(Date, 2)
 
 
 
        For I = 1 To 5
        On Error Resume Next    'copie les données de la semaine
            Set Ws = ThisWorkbook.Worksheets(Format(Date - JourSem + I, "dd-mm-yyyy"))
            If Ws Is Nothing Then MsgBox "toto"
                On Error GoTo 0
               ligne = Ws.Range("A" & Range("A:A").Rows.Count).End(xlUp).Row
                Ws.Range("A1:B" & ligne).Copy
                .Range("A1").Insert Shift:=xlDown
        Next I
 
        End With
    'Wbk.Close True
Set Wbk = Nothing
Else
    MsgBox "Fichier " & Chemin & " inexistant"
End If
 
End Sub

Test.xlsx
CopieTest.xlsx
Merci Daniel.

[Daniel.C]

Hé ! J'ai marqué "Adapte"...
Essaie :

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
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
Dim plage As Range
 
 
Application.ScreenUpdating = False
Chemin = "C:\CopieTest.xlsx"
If Dir(Chemin) <> "" Then
    Set Wbk = Workbooks.Open(Filename:=Chemin, UpdateLinks:=False)
 
    With Wbk.Worksheets(1)                              ''supprime les données des dates de la semaine
 
    Application.ScreenUpdating = False
    'Set Wbk = ActiveWorkbook
        .Rows(1).Insert
        .[A1] = "bidon"
        .AutoFilterMode = False
        Set plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
        plage.AutoFilter 1, Format(Date, "dd/mm/yyyy")
 
        Set plage = plage.Offset(1).Resize(plage.Rows.Count - 1)
 
        If Application.Subtotal(103, plage) > 0 Then
            Set plage = plage.SpecialCells(xlCellTypeVisible)
            plage.EntireRow.Delete
            .AutoFilterMode = False
        .Rows(1).Delete
        Else
        .AutoFilterMode = False
        .Rows(1).Delete
        End If
 
 
 JourSem = Application.Weekday(Date, 2)
 
 
        On Error Resume Next    'copie les données de la semaine
        For I = 1 To 5
        On Error Resume Next    'copie les données de la semaine
            Set Ws = ThisWorkbook.Worksheets(Format(Date - JourSem + I, "dd-mm-yyyy"))
            If Not Ws Is Nothing Then
                On Error GoTo 0
               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
 
        End With
    'Wbk.Close True
Set Wbk = Nothing
Else
    MsgBox "Fichier " & Chemin & " inexistant"
End If
 
End Sub

[manu900]

Sa gonfle, j'ai essayé un tas de truc jusqu’à faire planté mon pc une dizaine de fois.

Mais ce que je ne comprend absolument pas c'est que lorsque par exemple I=2, il devrai détecté que WS n'existe pas quand i=2 et devrai donc aller à l'étape suivante, c'est à dire exécuter la boucle pour I=3. Hors, il continu le programme jusqu’à copié 4 fois de plus les données quand I=1.
De plus, ce qui est étrange c'est que en mode pas à pas tu vois bien le I changer de valeur.

C'est à ce tirer les cheveux.

voilà un des tests que j'ai réalisé

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 On Error Resume Next    'copie les données de la semaine
        For I = 1 To 5
1:        On Error Resume Next   'copie les données de la semaine
            Set Ws = ThisWorkbook.Worksheets(Format(Date - JourSem + I, "dd-mm-yyyy"))
            If Not Ws = I Is Nothing Then
                On Error GoTo 1
               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

Merci bonne soirée

[jfontaine]

Bonjour,

Sans regarder en détail ton code, cette ligne me saute aux yeux

Code :

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

If Not Ws = I Is Nothing Then

remplaces par

Code :

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

If Not Ws Is Nothing Then