Bonjour à tous,
Je fais une nouvelle fois appel à votre savoir!!!
j'ai une feuille sur laquelle j'aimerais copier la plage c4:n4 et cela systématiquement du 01 au 05 octobre (ou a la 1ere ouverture du fichier du mois d'octobre), puis la coller dans l'onglet BaseN-1 à la ligne qui correspond à l'année n-1, exemple:
j'ouvre mon fichier le 02 octobre 2023, à l'open du classeur il copie la plage et la colle (que les valeurs) à la ligne 2022 de BaseN-1.
Je ne sais pas si mes explications sont assez claires.
Merci beaucoup de votre aide
Eric
Comme quoi il vaut mieux poster avec un fichier exemple, ça diminue le risque d'itération ...
Voilà la macro Workbook_Open adaptée à ta nouvelle demande :
VB:
Private Sub Workbook_Open()
Dim Année_Ant%, lgnS%, lgnF%, DéjàRenseignée As Boolean
Const MoisRecopie As Byte = 3 'mois pour lequel déclencher la macro
If Month(Date) = MoisRecopie Then
Année_Ant = Year(Date) - 1
'On recherche les lignes de type Signe et Facture pour l'année antérieure
lgnS = -1: lgnF = -1
On Error Resume Next
lgnS = Evaluate("MATCH(""" &...
Sur l'exemple que je te propose, j'ai une feuille Source avec un nom défini "PlageàCopier" (les cellules c4:n4)
et une feuille "BaseN-1" avec un tableau structuré "tb_Cible" et les colonnes "Année" et "Info1" à "Info12".
La macro se trouve dans Thisworkbook procédure Workbook_Open le mois pour déclencher la macro dans la constante MoisRecopie (j'ai mis 3 pour tester en mars, à remplacer par 10 pour exécution en octobre) :
VB:
Private Sub Workbook_Open()
Dim Année_Ant%, lgn%, DéjàRenseignée As Boolean
Const MoisRecopie As Byte = 3 'mois pour lequel déclencher la macro
If Month(Date) = MoisRecopie Then
Annéée_Ant = Year(Date) - 1
'recherche de l'année cible (année antérieure)
lgn = -1
On Error Resume Next
lgn = WorksheetFunction.Match(Annéée_Ant, BaseN_1.[tb_cible[Année]], 0)
If lgn = -1 Then MsgBox "Année antérieure (" & Année_Ant & ") absente)": Exit Sub
On Error GoTo 0
'Les informations sont-elles déjà recopiées ?
DéjàRenseignée = WorksheetFunction.CountA(BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgn)) > 0
If DéjàRenseignée Then Exit Sub
'Copie des valeurs de la Plage source vers la ligne lgn du tableau cible
BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgn) = Source.[PlageàCopier].Value
End If
End Sub
Je vérifie le mois en cours, si on trouve dans le tableau l'année antérieure, et si pour l'année antérieure il y a déjà des informations recopiées. Si tout est OK je fais la recopie des valeurs de la plage à copier.
Sur l'exemple que je te propose, j'ai une feuille Source avec un nom défini "PlageàCopier" (les cellules c4:n4)
et une feuille "BaseN-1" avec un tableau structuré "tb_Cible" et les colonnes "Année" et "Info1" à "Info12".
La macro se trouve dans Thisworkbook procédure Workbook_Open le mois pour déclencher la macro dans la constante MoisRecopie (j'ai mis 3 pour tester en mars, à remplacer par 10 pour exécution en octobre) :
VB:
Private Sub Workbook_Open()
Dim Année_Ant%, lgn%, DéjàRenseignée As Boolean
Const MoisRecopie As Byte = 3 'mois pour lequel déclencher la macro
If Month(Date) = MoisRecopie Then
Annéée_Ant = Year(Date) - 1
'recherche de l'année cible (année antérieure)
lgn = -1
On Error Resume Next
lgn = WorksheetFunction.Match(Annéée_Ant, BaseN_1.[tb_cible[Année]], 0)
If lgn = -1 Then MsgBox "Année antérieure (" & Année_Ant & ") absente)": Exit Sub
On Error GoTo 0
'Les informations sont-elles déjà recopiées ?
DéjàRenseignée = WorksheetFunction.CountA(BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgn)) > 0
If DéjàRenseignée Then Exit Sub
'Copie des valeurs de la Plage source vers la ligne lgn du tableau cible
BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgn) = Source.[PlageàCopier].Value
End If
End Sub
Je vérifie le mois en cours, si on trouve dans le tableau l'année antérieure, et si pour l'année antérieure il y a déjà des informations recopiées. Si tout est OK je fais la recopie des valeurs de la plage à copier.
Re Bonjour,
Sans vouloir abuser de votre bonne volonté, mon tableau a évolué et, dans l'idéal il faudrait que les deux lignes soient recopiées "SIGNE" et "FACTURE" mais évidemment il ne reconnait qu'une ligne par année!!!
Après je ne vous embête plus...
Désolé et merci beaucoup
Eric
Comme quoi il vaut mieux poster avec un fichier exemple, ça diminue le risque d'itération ...
Voilà la macro Workbook_Open adaptée à ta nouvelle demande :
VB:
Private Sub Workbook_Open()
Dim Année_Ant%, lgnS%, lgnF%, DéjàRenseignée As Boolean
Const MoisRecopie As Byte = 3 'mois pour lequel déclencher la macro
If Month(Date) = MoisRecopie Then
Année_Ant = Year(Date) - 1
'On recherche les lignes de type Signe et Facture pour l'année antérieure
lgnS = -1: lgnF = -1
On Error Resume Next
lgnS = Evaluate("MATCH(""" & Année_Ant & "Signe"",tb_cible[Année]&tb_cible[Type],0)") 'Ligne avec Type "Signe"
lgnF = Evaluate("MATCH(""" & Année_Ant & "Facture"",tb_cible[Année]&tb_cible[Type],0)") 'Ligne avec type "Facture"
If lgnS = -1 Or lgnF = -1 Then MsgBox "Année antérieure (" & Année_Ant & " type Signe et/ou Facture absente)": Exit Sub
On Error GoTo 0
'Les informations sont-elles déjà recopiées (Signe et/ou Facture) ?
With WorksheetFunction
DéjàRenseignée = .CountA(BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnS)) + .CountA(BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnF)) > 0
End With
If DéjàRenseignée Then Exit Sub
'Copie des valeurs de la Plage source vers les lignes lgnS et lgnF du tableau cible
BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnS) = Source.[PlageàCopier].Rows(1).Value
BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnF) = Source.[PlageàCopier].Rows(2).Value
End If
End Sub
Tu remarqueras le passage par "Evaluate" en effet WorksheetFunction.Match n'accepte pas une recherche multi-colonnes à la différence de EQUIV (ou MATCH) dans une feuille de calcul.
Je recherche les lignes type Signe et type Facture individuellement sans présumer qu'elles soient consécutives.
Comme quoi il vaut mieux poster avec un fichier exemple, ça diminue le risque d'itération ...
Voilà la macro Workbook_Open adaptée à ta nouvelle demande :
VB:
Private Sub Workbook_Open()
Dim Année_Ant%, lgnS%, lgnF%, DéjàRenseignée As Boolean
Const MoisRecopie As Byte = 3 'mois pour lequel déclencher la macro
If Month(Date) = MoisRecopie Then
Année_Ant = Year(Date) - 1
'On recherche les lignes de type Signe et Facture pour l'année antérieure
lgnS = -1: lgnF = -1
On Error Resume Next
lgnS = Evaluate("MATCH(""" & Année_Ant & "Signe"",tb_cible[Année]&tb_cible[Type],0)") 'Ligne avec Type "Signe"
lgnF = Evaluate("MATCH(""" & Année_Ant & "Facture"",tb_cible[Année]&tb_cible[Type],0)") 'Ligne avec type "Facture"
If lgnS = -1 Or lgnF = -1 Then MsgBox "Année antérieure (" & Année_Ant & " type Signe et/ou Facture absente)": Exit Sub
On Error GoTo 0
'Les informations sont-elles déjà recopiées (Signe et/ou Facture) ?
With WorksheetFunction
DéjàRenseignée = .CountA(BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnS)) + .CountA(BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnF)) > 0
End With
If DéjàRenseignée Then Exit Sub
'Copie des valeurs de la Plage source vers les lignes lgnS et lgnF du tableau cible
BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnS) = Source.[PlageàCopier].Rows(1).Value
BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnF) = Source.[PlageàCopier].Rows(2).Value
End If
End Sub
Tu remarqueras le passage par "Evaluate" en effet WorksheetFunction.Match n'accepte pas une recherche multi-colonnes à la différence de EQUIV (ou MATCH) dans une feuille de calcul.
Je recherche les lignes type Signe et type Facture individuellement sans présumer qu'elles soient consécutives.
Comme quoi il vaut mieux poster avec un fichier exemple, ça diminue le risque d'itération ...
Voilà la macro Workbook_Open adaptée à ta nouvelle demande :
VB:
Private Sub Workbook_Open()
Dim Année_Ant%, lgnS%, lgnF%, DéjàRenseignée As Boolean
Const MoisRecopie As Byte = 3 'mois pour lequel déclencher la macro
If Month(Date) = MoisRecopie Then
Année_Ant = Year(Date) - 1
'On recherche les lignes de type Signe et Facture pour l'année antérieure
lgnS = -1: lgnF = -1
On Error Resume Next
lgnS = Evaluate("MATCH(""" & Année_Ant & "Signe"",tb_cible[Année]&tb_cible[Type],0)") 'Ligne avec Type "Signe"
lgnF = Evaluate("MATCH(""" & Année_Ant & "Facture"",tb_cible[Année]&tb_cible[Type],0)") 'Ligne avec type "Facture"
If lgnS = -1 Or lgnF = -1 Then MsgBox "Année antérieure (" & Année_Ant & " type Signe et/ou Facture absente)": Exit Sub
On Error GoTo 0
'Les informations sont-elles déjà recopiées (Signe et/ou Facture) ?
With WorksheetFunction
DéjàRenseignée = .CountA(BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnS)) + .CountA(BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnF)) > 0
End With
If DéjàRenseignée Then Exit Sub
'Copie des valeurs de la Plage source vers les lignes lgnS et lgnF du tableau cible
BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnS) = Source.[PlageàCopier].Rows(1).Value
BaseN_1.[tb_cible[[Info1]:[Info12]]].Rows(lgnF) = Source.[PlageàCopier].Rows(2).Value
End If
End Sub
Tu remarqueras le passage par "Evaluate" en effet WorksheetFunction.Match n'accepte pas une recherche multi-colonnes à la différence de EQUIV (ou MATCH) dans une feuille de calcul.
Je recherche les lignes type Signe et type Facture individuellement sans présumer qu'elles soient consécutives.