Discussion :

[Chtibigourdan]

Bonjour à tous, je vais encore faire appel à vous!

Je vous explique mon problème:
Je souhaite créer une macro qui permet de faire un extract d'une semaine de mon fichier de plan de charge.
Et dans cet extract, je ne souhaite voir apparaître que les projets pour lesquels une ressource est affectée au moins un jour durant la semaine à extraire.

Le principe est donc de copier à partir de la feuille "PDC_2013_Prévi" sur la feuille "Extract_Semaine" une partie de l'en-tête du tableau relative aux dates, ainsi que les lignes de projets pour lesquelles il y a une ressource affectée au moins un jour durant la semaine à extraire

Voici le code que j'ai écrit:

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Explicit
    'Sauvegarde
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim Nom, chemin As String
    'Extract
    Dim i, j, k As Integer
    Dim SEM As String
    Dim DebutSEM As String
    Dim Journ As String
    Dim JourVar As String
    Dim NBAffectation As String
    Dim LigneCourante As String
    Dim LigneLibre As String
 
Sub Commande_Cliquer()
 
    SEM = InputBox("Rentrer le numéro de la semaine", "Numéro de semaine")
    SEM = "S" & SEM
    NBAffectation = Sheets("PDC_2013_Prévi").Range("E65536").End(xlUp).Row + 1
 
    'Trouver la date de début
    i = 13
    While Sheets("PDC_2013_Prévi").Cells(3, i).Value <> SEM
        i = i + 1
    Wend
 
    DebutSEM = i
    Journ = DebutSEM
 
    'Copier le bandeau de la bonne semaine
    k = 13
    While Sheets("PDC_2013_Prévi").Cells(3, i).Value = SEM
        For j = 1 To 5
            Sheets("Extract_Semaine").Cells(j, k).Value = Sheets("PDC_2013_Prévi").Cells(j, i).Value
        Next
        i = i + 1
        k = k + 1
    Wend
 
    'Copier les lignes affectées
    LigneCourante = 6
    While LigneCourante <> NBAffectation
 
        If Sheets("PDC_2013_Prévi").Cells(LigneCourante, 5).Value <> "" Then
 
            Do While Sheets("PDC_2013_Prévi").Cells(3, Journ).Value = SEM
 
                JourVar = DebutSEM
                If Sheets("PDC_2013_Prévi").Cells(LigneCourante, Journ).Value <> "" Then
                    LigneLibre = Sheets("Extract_Semaine").Range("E65536").End(xlUp).Row + 1
 
                    For i = 1 To 12
                        Sheets("Extract_Semaine").Cells(LigneLibre, i).Value = Sheets("PDC_2013_Prévi").Cells(LigneCourante, i).Value
                    Next
 
                    j = 13
 
                    For i = JourVar To JourVar + 6
                        Sheets("Extract_Semaine").Cells(LigneLibre, j).Value = Sheets("PDC_2013_Prévi").Cells(LigneCourante, i).Value
                        j = j + 1
                    Next
 
                    Exit Do
 
                End If
 
                Journ = Journ + 1
 
            Loop
 
        Else
            LigneCourante = LigneCourante + 1
        End If
        LigneCourante = LigneCourante + 1
    Wend
 
End Sub

Ce code me donne une erreur 1004... sur la boucle loop while et je ne sais pas pourquoi.
Je vous laisse aussi mon tableau allégé en pièce jointe.
Et je vous remercie de l’intérêt que vous allez porter à ma demande.
Bonne soirée

[mercatog]

Bonsoir

Je n'ai pas regardé votre code, mais j'ai proposé une autre variante (à adapter éventuellement au niveau résultat obtenu)

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
Sub Commande_Cliquer()
Dim Plage As Range, c As Range, v As Range
Dim Lastlig As Long, i As Long
Dim AuMoins As Boolean
Dim SEM As String
Dim k As Byte
 
SEM = InputBox("Rentrer le numéro de la semaine", "Numéro de semaine")
SEM = "S" & SEM
 
Worksheets("Extract_Semaine").UsedRange.Clear
 
With Worksheets("PDC_2013_Prévi")
    Set c = .Rows(3).Find(SEM, LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlNext)
    If Not c Is Nothing Then
        Set v = .Rows(3).Find(SEM, LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlPrevious)
        k = v.Column - c.Column + 1
        Lastlig = .Cells(.Rows.Count, "I").End(xlUp).Row
        Set Plage = Union(.Range("B4:L5"), c.Offset(1, 0).Resize(2, k))
 
        For i = 6 To Lastlig
            Set v = c.Offset(i - 3, 0).Resize(1, k)
            If Application.Count(v) <> 0 Then
                AuMoins = True
                Set Plage = Union(Plage, .Range("B" & i & ":L" & i), v)
            End If
        Next i
        Set v = Nothing
        If AuMoins Then Plage.Copy Worksheets("Extract_Semaine").Range("B4")
        Set Plage = Nothing
        Set c = Nothing
    End If
End With
End Sub

[Chtibigourdan]

Merci beaucoup pour la réponse...
J'ai pas tout compris, mais ça marche impécable.

J'aimerais bien moi aussi connaitre et utiliser les fonctions VBA. Existe-t-il un livre que je peux acheter pour apprendre?