Macro pour dupliquer des données

Bonjour au forum,

Dans mon exemple, une macro permet de copier au quotidien les données (I6 :J6) du Tableau 2 à la dernière cellule vide du Tableau 1.

Les données du tableau 2 sont une extraction journalière du chiffre d’affaire de la veille.

Je voudrai inclure dans ma macro, que si on est le 1er jour de la semaine, cette macro me duplique les données de vendredi aux journées de samedi et dimanche. Je ne suis pas assez compétent pour le faire.

Je vous remercie d'avance de votre aide.

Sub Taux()

    Range("I6:J6").Select
    Selection.Copy
    Range("B" & Range("B65535").End(xlUp).Row + 1).Select
    ActiveSheet.Paste

End Sub

Bonjour,

Une proposition

A+

Bonjour Frangy,

Merci pour ta proposition, le code ne me permet vraiment pas de dupliquer comme je veux les données de vendredi aux Samedi et Dimanche.

Le tableau 2 est une extraction qui représente les données de la veille, date indiquée en I6.

Par exemple, si on est le 06/10/2014, la date indiquée dans le tableau 2 sera donc le 03/10/2014.

La macro dupliquera ces données 3 fois.

Néanmoins, j’ai essayé de modifier ton code en simulant qu’on est le 1er de la semaine en indiquant en cellule I3 =AUJOURDUI()+4.

Même avec cette modification n’est guère satisfaisante.

JourJ = Weekday(.Range("I3"), 2)

Si j'ai bien compris, tu souhaites donc que la procédure effectue la recopie des données du vendredi sur le samedi et dimanche lorsque le jour en I6 est un vendredi.

A+

Merci Frangy, c'est exactement ce que je recherche.

Est-il possible que tu m'expliquer les codes que tu as mis dans la macro ?

Je vais essayer d'appliquer à mon fichier.

Voici le code commenté

Sub Taux()
Dim JourJ As Integer, DerJour As Integer
Dim DerLig As Long
Dim i As Byte
    With Worksheets("CA")
        'On détermine le numéro du jour indiqué en I6
        JourJ = Weekday(.Range("I6"), 2)
        'On détermine le numéro du dernier jour indiqué en colonne B
        DerJour = Weekday(.Range("B" & Rows.Count).End(xlUp), 2)
        'On effectue la copie de I6:J6 en fin de tableau 1
        .Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(1, 2).Value = .Range("I6:J6").Value
        'Si on est dans le cas où le jour en I6 est un vendredi
        'et le dernier jour indiqué en colonne B (avant copie) est un jeudi
        If JourJ = 5 And DerJour = 4 Then
            'alors, on ajoute les valeurs pour le samedi et le dimanche
            For i = 1 To 2
                DerLig = .Range("B" & Rows.Count).End(xlUp).Row
                .Range("B" & DerLig + 1).Value = .Range("B" & DerLig).Value + 1
                .Range("C" & DerLig + 1).Value = .Range("C" & DerLig).Value
            Next i
        End If
    End With
    Application.CutCopyMode = False
End Sub

N'hésites pas à demander un complément d'info si tu as besoin d'explication sur un point particulier.

A+

oui maintenant, c'est plus clair, mais admettons que le Tableau 1 se trouve dans un autre fichier. Où doit-on idiquer dans la macro le chemin et le nom du fichier ?

Merci encore de ton aide.

Si les deux classeurs sont dans le même dossier, tu devrais avoir un code qui ressemble à cela :

Sub Taux()
Dim WsS As Worksheet, WsC As Worksheet
Dim JourJ As Integer, DerJour As Integer
Dim DerLig As Long
Dim i As Byte
    Set WsS = ThisWorkbook.Worksheets("CA") 'Classeur Source
    Set WsC = Workbooks("Suivi_CA.xls").Worksheets("CA") 'Classeur Cible
    JourJ = Weekday(WsS.Range("I6"), 2)
    DerJour = Weekday(WsC.Range("B" & WsC.Rows.Count).End(xlUp), 2)
    WsC.Range("B" & WsC.Rows.Count).End(xlUp).Offset(1).Resize(1, 2).Value = WsS.Range("I6:J6").Value
    If JourJ = 5 And DerJour = 4 Then
        For i = 1 To 2
            DerLig = WsC.Range("B" & Rows.Count).End(xlUp).Row
            WsC.Range("B" & DerLig + 1).Value = WsC.Range("B" & DerLig).Value + 1
            WsC.Range("C" & DerLig + 1).Value = WsC.Range("C" & DerLig).Value
        Next i
    End If
    Application.CutCopyMode = False
End Sub

Si les deux classeurs ne sont pas dans le même dossier, il faudra ajouter le chemin pour le classeur cible.

Attention ! les deux classeurs doivent être ouverts.

A+

Bonjour frangy,

J'ai appliqué les macros à mes fichiers, mais cependant je rencontre un léger problème. Je n'arrive pas à dupliquer parfaitement les données de vendredi qui représentent 162 lignes sur le samedi et dimanche. La macro ne me duplique qu’ 1 ligne sur les 162

Qu'est-ce qui ne va pas ?

Sub MiseAjour2()

Dim WsS As Worksheet, WsC As Worksheet
Dim JourJ As Integer, DerJour As Integer
Dim DerLig As Long
Dim i As Byte
    Set WsS = ThisWorkbook.Worksheets("Tréso") 'Classeur Source
   Set WsC = Workbooks("Suivi_CA.xlsx").Worksheets("Tréso") 'Classeur Cible

   'On dédertmine la date du jour indiqué en A2
   JourJ = Weekday(WsS.Range("A2"), 2)

   'On détermine le dernier jour indiqué en colonne A
    DerJour = Weekday(WsC.Range("A" & WsC.Rows.Count).End(xlUp), 2)

   'On effectue la copie de A2 à L162
    WsC.Range("A" & WsC.Rows.Count).End(xlUp).Offset(1).Resize(161, 12).Value = WsS.Range("A2:L162").Value

    ''Si on est dans le cas où le jour en A2 est un vendredi
       'et le dernier jour indiqué en colonne A (avant copie) est un jeudi
    If JourJ = 5 And DerJour = 4 Then
        For i = 1 To 2
            DerLig = WsC.Range("A" & Rows.Count).End(xlUp).Row
            WsC.Range("A" & DerLig + 1).Value = WsC.Range("A" & DerLig).Value + 1
            WsC.Range("L" & DerLig + 1).Value = WsC.Range("L" & DerLig).Value
        Next i
    End If
    Application.CutCopyMode = False
End Sub

Vici le 2è fichier test..

Bonjour,

Ce qui ne va pas, c’est que le programme n’a pas été conçu pour copier plusieurs lignes.

En règle générale, il faut t’efforcer de présenter un exemple qui colle à la réalité, sinon ...

Voici une nouvelle version.

A+

Bonjour,

Pourrais-tu me commenter ce la fin de ton code ?

 If JourJ = 5 Then
        For i = 1 To 2
            PremLigne = WsC.Range("A" & Rows.Count).End(xlUp).Row + 1
            DerLigne = PremLigne + PlageàCopier.Rows.Count - 1
            PlageàCopier.Copy WsC.Range("A" & PremLigne)
            With WsC.Range("A" & PremLigne)
                .Value = .Value + i
                .AutoFill Destination:=WsC.Range("A" & PremLigne & ":A" & DerLigne), Type:=xlFillCopy
            End With
        Next i
    End If
    Set PlageàCopier = Nothing: Set WsC = Nothing: Set WsS = Nothing
    Application.CutCopyMode = False