Macro personnelle

Bonjour,

Je reçois par mail tous les jours deux extractions que je copie colle 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 : Test.MACRO_PERSO…xlsm (596,9 Ko)

Voici ma macro personnelle :

Sub ouvrir_Indicateurs_Collage_2020()

Dim url_Indicateurs_Collage_2020 As String

url_Indicateurs_Collage_2020 = « \APSVPFSMB01\Commun\COLLABORATEURS\Collage\Indicateurs_Collage_2020.xlsm »

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,

Bonjour,

Pourquoi cela ne fonctionne pas ?
1ère erreur:

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

ATTENTION: en VBA Majuscule et Minuscule sont à respecter (.XLS n’est surement pas en majuscule)

2ème erreur:

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

ATTENTION, il y a un espace après le 010,

Le reste fonctionnera pour le premier classeur, le deuxième (AS400) ne sera pas reconnu, car tu ne l’a pas recherché

Teste ceci
Indicateurs_Collage_2020.xlsm (594,2 Ko)

Bonjour,

Merci pour votre retour.
J’ai testé avec votre fichier mais le message apparaît toujours…
Je vous joins les deux fichiers que je reçois par mail.

intraprint2xls_010_20200708140000.xls (15 Ko)

XFRGOGE _20200708.XLS (2,2 Mo)

Bien cordialement,

Re,
Regarde un peu comment est écrit le nom de ce classeur

XFRGOGE _ n’est pas égal à XFRGOGE_
Un espace est un espace
Alors il faut savoir comment est envoyé chaque jour ton classeur avec ou sans, et rectifier dans la macro en ajoutant un espace au cas où.

J’avais même pas vu cet espace … Merci j’ai corrigé et ça fonctionne !!

J’ai une autre question, je n’y a vais pas pensé et c’est en lançant la macro que j’ai vu ça.

Un des fichiers que je reçois tous les jours doit être copié collé à la suite du copier coller de la veille. ça ne vient pas remplacer toute la feuille, les infos du fichier reçues viennent s’ajouter à la suite des valeurs de la veille…
C’est l’extraction Intraprint qui vient dans l’onglet Extract_Intraprint.

Une idée de comment y remédier ?

Cordialement,

Re,

Remplace la macro par celle-ci (Après, avec plus de temps, elle serait beaucoup plus courte et fonctionnelle,surtout sans avoir les classeurs ouverts au départ)
ATTENTION, elle est prévue pour un classeur XFRGOGE _ (avec un espace)

Option Compare Text

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
        Dim Dl%
        Dl = Range("A" & Rows.Count).End(xlUp).Row + 1
        Range("A" & Dl).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False

        Workbooks(fichierintraprint).Close
    End If
Next wb
For Each wb In Workbooks
    'copier les données AS400
    If wb.Name Like "XFRGOGE _" & "*" & ".xls" Then
    
        fichierAS400 = wb.Name
        Workbooks(fichierAS400).Sheets(1).Activate
        Range("A2:Y65000").Select
        Selection.Copy
        
        Workbooks(Indicateurs_collage).Sheets("Extraction_AS400").Activate
        Range("A2:Y65000").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False

        Workbooks(fichierAS400).Close
    End If
Next wb

End Sub

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.