Microsoft 365 macro personnelle

Coralie01120

XLDnaute Occasionnel
Bonjour,

Je reçois par mail tous les jours deux extractions qui sont copiées collées dans un fichier excel. Chaque onglet correspond à une extraction.
Pour gagner un peu de temps j'ai voulu installer une macro personnelle mais mon code n'a pas l'air de fonctionner...Pouvez-vous m'aider ?
Les deux fichiers excel reçu par mail ont leurs noms qui varient en fonction de la date.
Le premier : XFRGOGE_20200708.XLS (la date varie) et le deuxième intraprint2xls_010_2020070814001.xls (la date varie et le 14001 aussi). Je ne sais pas trop si j'ai bien réaliser le codage. Quand j'ouvre mes deux fichiers excel et que je lance ma macro perso ça me dit le MSGBOX "Il faut ouvrir les 2 extractions AS400 avant d'activer la macro". Pourtant les 2 sont ouverts.

Je vous joins le fichier test.

Voici ma macro personnelle :

Sub ouvrir_Indicateurs_Collage_2020()

Dim url_Indicateurs_Collage_2020 As String

url_Indicateurs_Collage_2020 = "Lien supprimé"

Workbooks.Open url_Indicateurs_Collage_2020, ReadOnly:=False

Application.Run ("Indicateurs_Collage_2020.xlsm!MettreAJour") 'lancer la macro

End Sub

Voici ma macro dans le fichier :

Sub MettreAJour()

'déclaration des variables

Dim DerLigne1 As Long, DerLigne2

Indicateurs_collage = "Indicateurs_Collage_2020.xlsm"

'---------------------------

Application.ScreenUpdating = False

'---------------------------



'ETAPE 1 : vérifier que les 2 fichiers BDDS sont bien ouverts

'---------------------------

Dim wb As Workbook

For Each wb In Workbooks

If wb.Name Like "XFRGOGE_" & "*" & ".XLS" Then fichier1 = 1

If wb.Name Like "intraprint2xls_010_ " & "*" & ".xls" Then fichier2 = 1

Next wb



If fichier1 + fichier2 < 2 Then

MsgBox ("Il faut ouvrir les 2 extractions avant d'activer la macro !")

Workbooks(Indicateurs_collage).Close

Exit Sub

End If



' ETAPE 2 : copier les 2 fichiers AS400 puis les fermer

'---------------------------

'nettoyer l’onglet AS400

Workbooks(Indicateurs_collage).Sheets("Extraction_AS400").Range("A2:Y65000").ClearContents

Workbooks(Indicateurs_collage).Sheets("Extraction_Intraprint").Range("A2:Y65000").ClearContents





'copier les données Intraprint

For Each wb In Workbooks

If wb.Name Like "intraprint2xls_010_ " & "*" & ".XLS" Then



Fichierintraprint = wb.Name

Workbooks(fichierintraprint).Sheets(1).Activate

Range("A2:Y65000").Select

Selection.Copy



Workbooks(Indicateurs_collage).Sheets("Extraction_Intraprint").Activate

Range("A2:Y65000").Select

ActiveSheet.Paste

Application.CutCopyMode = False



Workbooks(fichierintraprint).Close

End If

Next wb



'copier les données AS400

Workbooks(fichierAS400).Sheets(1).Activate

Range("A2:I65000").Select

Selection.Copy

Workbooks(Indicateur_collage).Sheets("Extraction_AS400").Activate

Range("A2:I65000").Select

ActiveSheet.Paste

Application.CutCopyMode = False



Workbooks(fichierAS400).Close


Merci pour votre aide,
 

Pièces jointes

  • Test.MACRO_PERSO..xlsm
    596.9 KB · Affichages: 4

Discussions similaires

Statistiques des forums

Discussions
315 109
Messages
2 116 318
Membres
112 716
dernier inscrit
jean1234