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