Probleme boucle for avec if

Version imprimable

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:

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

Bonjour,

Adapte :

Code:

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

2 pièce(s) jointe(s)

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:

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

Pièce jointe 98965
Pièce jointe 98966
Merci Daniel.

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

Code:

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

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:

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

13/07/2012, 18h50
jfontaine

Bonjour,

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

Code:

If Not Ws = I Is Nothing Then

remplaces par

Code:

If Not Ws Is Nothing Then
13/07/2012, 19h02
Philippe Tulliez

Bonjour,
J'allais répondre la même chose que Jérôme
Daniel t'a proposé

Code:

If Not ws Is Nothing Then

Que tu transformes en

Code:

If Not Ws = I Is Nothing Then

et de plus
Tu transformes

Code:

On Error GoTo 0

En

Code:

On Error GoTo 1

Un peu de lecture sur la gestion des erreurs
13/07/2012, 19h31
manu900

En effet, ce fut un test que j'ai effectué pour voir si cela fonctionnait. Toutefois même en modifiant ces deux lignes, cela copie toujours 5 fois la seule date qu'il y a dans la semaine.

Merci.

Cordialement

Bonsoir,

C'est de la faute à Mark Twain et à Jérôme), avec ses phrases à deux balles :

Citation:

"Ils ne savaient pas que c'était impossible, alors ils l'ont fait" - Marc Twain

Des fois c'est quand même impossible...
:D:D:D

Essaie comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
        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"))
            On Error GoTo 0
            If Not Ws Is Nothing Then
                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

13/07/2012, 20h38
jfontaine

Citation:

C'est de la faute à Mark Twain et à Jérôme), avec ses phrases à deux balles :
Citation:
"Ils ne savaient pas que c'était impossible, alors ils l'ont fait" - Marc Twain
Des fois c'est quand même impossible...

:koi:
M'enfin, Marc Twain c'est quand même mieux qu' Alain Chamfort :mouarf1: :P:P:P

Oups, au temps pour moi :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
        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"))
            On Error GoTo 0
            If Err.Number <> 0 Then
                Err.Clear
            Else
                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

Bonjour Daniel,

Cela ne fonctionne toujours pas il me copie plusieurs fois la même date lorsque les autre feuille de la semaine n'existe pas. J'ai essayé tout le week-end, et j'ai fais des test avec la fonction exist sans grande résussite. Voici un exemple :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 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"))
            On Error GoTo 0
            If Not Exist(Ws) Then
            Next I
            Err.Clear
 
            Else
                ligne = Ws.Range("B" & Range("B:B").Rows.Count).End(xlUp).Row
                Ws.Range("A4:J" & ligne).Copy
                .Range("A2").Insert Shift:=xlDown
            End If
        Next I

merci pour ton aide Daniel.

16/07/2012, 10h25
HopPopPop

Avez-vous fait une compilation, car tel que c'est présenté, un message d'erreur de l'interpréteur devrait apparaitre.

Vous utilisez 2 fois l'instruction Next pour 1 boucle For.
16/07/2012, 10h35
Daniel.C

Bonjour,

Reprends le code tel que je l'ai mis dans mon message du 13/7/2012 21:06. Pourquoi est-ce que tu t'obstines à modifier ce code ? Sans compter que, comme l'a fait remarquer HopPopPop, tu n'as pas pu faire fonctionner la macro.
16/07/2012, 13h25
manu900

Merci pour ta réponse Daniel.

Si je m'obstine à modifier le code car la proposition du 13/7/2012 à 21h06 ne fonctionne pas. Je vais essayé de mieux expliqué le problème.

Par exemple, nous sommes en semaine 29, et j'aurai seulement deux feuilles, celles du 16/07/2012 et du 19/07/2012 avec bien sur du contenu. Le problème c'est que lorsque je lance la macro, il me copie 3 fois le contenue de la feuille du 16 (1 fois normale + 2 fois de trop) et deux fois celle du 19 (1 fois normal et 1 fois de trop).

Ce que j'essaye de faire, c'est que lorsque la feuille n'existe pas il passe à la suivante. reprenon mon exemple :

Quand I=1 c'est à dire le 16/07/2012
il copie les données de la feuille puis la boucle se poursuit
Quand I=2 c'est à dire le 17/07/2012
cette feuille n'existe pas donc il passe à I=3. Le problème qui se pose c'est que la macro me copie encore les données du 16.
Ce problème se répete quand I=3 c'est à dire le 18/07/2012
Quand I=4 c'est à dire le 19/07/2012
il copie les données de la feuille puis continu sa boucle
Quand I=5 c'est à dire le 20/07/2012
cette feuille n'existe pas mais il me copie les données de la feuille du 19/07/2012.

Pour conclure, il faudrai que lorsque la feuille n'existe pas il passe au jours suivant sans copier quoi que ce soit.

J'èspere avoir été claire et je te remerci encore Daniel.

Bonjour,
Le code de Daniel fonctionne, pour autant qu'on déplace la ligne "On Error Goto 0".
En effet, elle remet à 0 le code de l'erreur, le test "If Err.Number <> 0 Then" est donc toujours faux.
Voici le code adapté (stockage de la valeur de l'erreur avant de le réinitialiser) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
        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"))
            intErr = Err.Number
            On Error GoTo 0
            If intErr <> 0 Then
                Err.Clear
            Else
                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

16/07/2012, 15h51
manu900

Merci Beaucoup Tedo01 et merci à Daniel,

C'est bon cela fonctionne, j'ai juste nommé intErr comme étant une variable.

Merci encore à vous, bonne fin de journée.