Microsoft 365 Création macro personnelle

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

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

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
1
Affichages
782
Réponses
9
Affichages
982
Retour