Microsoft 365 Création macro personnelle

Coralie01120

XLDnaute Occasionnel
Bonjour,

Je dois alimenter un fichier excel grâce à une extraction que je reçois par mail.
Pour éviter le copier coller répétitif je souhaite créer une macro personnelle mais mon code beug.
Dans Suivi_Production_Nespresso1 l'onglet Extraction_AS400 est la feuille que je souhaite alimenter avec l'extraction que je reçois par mail BD_ProdActif.XLS.
Ma macro perso est :
Sub ouvrir_Suivi_Production_Nespresso()

Dim url_Suivi_Production_Nespresso As String

url_Suivi_Production_Nespresso = "Lien supprimé"

Workbooks.Open url_Suivi_Production_Nespresso1, ReadOnly:=False

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

End Sub


Ma macro sous Suivi_Production_Nespresso est :
Sub MettreAJour()
Dim usf1 As UserForm1
Set usf1 = New UserForm1
'd?claration des variables
Dim DerLigne1 As Long, DerLigne2
SuiviNespresso = "Suivi_Production_Nespresso1.xlsm"
fichierMaD = "BD_ProdActif.XLS"
'---------------------------
Application.ScreenUpdating = False
'---------------------------
'ETAPE 1 : v?rifier que le fichier BDD soit bien ouvert
'---------------------------
Dim wb As Workbook
If wb.Name Like "BD_ProdActif.XLS" Then fichier1 = 1
If fichier1 < 1 Then
MsgBox ("Il faut ouvrir l'extraction AS400 avant d'activer la macro !")
Workbooks(SuiviNespresso).Close
Exit Sub
End If
' ETAPE 2 : copier le fichier AS400 puis le fermer
'---------------------------
'nettoyer l'onglet
Workbooks(SuiviNespresso).Sheets("Extraction_AS400").Range("A2:AG1000000").ClearContents
'copier les donn?es AS400
Workbooks(fichierMaD).Sheets(1).Activate
Range("A2:AG1000000").Select
Selection.Copy
Workbooks(SuiviNespresso).Sheets("Extraction_AS400").Activate
Range("A2:AG1000000").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(fichierMaD).Close

' ETAPE 3 : ajouter les donn?es dans Suivi_Nespresso
With Sheets("Suivi_Nespresso")
.Activate
DerLigne = Range("A" & Rows.Count).End(xlUp).Row
' Qualit? carton
.Range("F7").FormulaLocal = "=SIERREUR(RECHERCHEV(""""&B7;Extraction_AS400!$A$2:$Z$500000;17;FAUX);"""")"
.Range("F7").AutoFill .Range("F7:F" & DerLigne)
' Grammage
.Range("G7").FormulaLocal = "=SIERREUR(RECHERCHEV(""""&B7;Extraction_AS400!$A$2:$Z$500000;16;FAUX);"""")"
.Range("G7").AutoFill .Range("G7:G" & DerLigne)
' Format
.Range("H7").FormulaLocal = "=SIERREUR(RECHERCHEV(D7;Donn?es!$B$3:$C$12;2;FAUX);"""")"
.Range("H7").AutoFill .Range("H7:H" & DerLigne)
' Couleurs RECTO
.Range("I7").FormulaLocal = "=SIERREUR(RECHERCHEV(""""&B7;Extraction_AS400!$A$2:$Z$500000;7;FAUX);"""")"
.Range("I7").AutoFill .Range("I7:I" & DerLigne)
' Vernis RECTO
.Range("J7").FormulaLocal = "=SIERREUR(RECHERCHEV(""""&B7;Extraction_AS400!$A$2:$Z$500000;9;FAUX);"""")"
.Range("J7").AutoFill .Range("J7:J" & DerLigne)
' remplacement des formules par les valeurs
Columns("F:J").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

End With
End Sub


Avez-vous une idée ?

Cordialement,
 

Pièces jointes

  • Suivi_Production_Nespresso1.xlsm
    23.6 KB · Affichages: 8
  • BD_ProdActif.XLS
    117.5 KB · Affichages: 6

pierrejean

XLDnaute Barbatruc
bonjour Coralie
vois si cela va mieux
1ere modif
For Each wb In Workbooks
If wb.Name Like "BD_ProdActif.XLS" Then fichier1 = 1
Next
2eme
Workbooks(SuiviNespresso).Sheets("Extraction_AS400").Activate
Range("A2:AG" & rows.count).Select
ActiveSheet.Paste
au lieu de
Workbooks(SuiviNespresso).Sheets("Extraction_AS400").Activate
Range("A2:AG1000000").Select
ActiveSheet.Paste
 

Coralie01120

XLDnaute Occasionnel
Bonjour,

Merci pour votre retour. Une fois que j'exécute la macro personnelle sur l'extraction que j'ai reçu le fichier Suivi_Production_Nespresso s'ouvre mais une erreur persiste et je ne vois pas laquelle.
1591793466309.png


Cordialement,
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Vous avez excel 365, pourquoi ne pas importer votre extraction par powerquery (inclus dans votre version) ce qui supprimerait les étapes 1 et 2 de votre macro et vous n'auriez pas à ouvrir 'BD_ProdActif.XLS'

Sans doute que vous pourriez préparer (rechercher ?) toutes les données à partir de PowerQuery.

Dans le fichier joint je me suis contenté d'importer le fichier les données. Comme les codes articles sont inexistants dans l'exemple, j'ai filtré sur 'Client <> null'.

PowerQuery se trouve dans l'onglet 'Données/Obtenir des Données/A partir d'un fichier/A partir d'un classeur'

Important :
dans la première étape (nommée Source) de la requête changez le chemin vers le fichier 'BD_ProdActif.XLS' avant de la mettre à jour.

Cordialement
 

Pièces jointes

  • Suivi_Production_Nespresso1.xlsm
    30.2 KB · Affichages: 6