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,
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,