VBA travail sur 3 classeurs
Bonjour
J'ai créé cette Macro. Elle fonctionne parfaitement bien mais j'aimerais cependant externaliser la chose pour plus de sécurité. Je m'explique:
Dans cette macro, je prend des données du classeur source (Gestion BRC) pour les copier sur un modèle (facturation Lot (modèle))puis créer un nouveau classeur. Je souhaiterais donc que toutes les fois ou est pris une valeur sur "Workbooks("Gestion BRC.xlsm").Sheets("RT")" elle soit désormais prise sur "Workbooks("RT Nancy.xslm").Sheets("RT"). Je vais donc devoir ouvrir ce fichier aussi (Ce classeur ne doit pas être enregistrer pendant cette opération). Attention cependant certaines fois des valeurs sont prises sur mon classeur source (Workbooks("Gestion BRC").Sheets("Extraction")) et il faut que ça continue comme ca. Je ferais donc du travail sur 3 classeurs à moins de les ouvrir et fermer plusieurs fois.
La macro à modifier:
Sub ExportFacturationLot()
Dim Cl As Workbook
Dim Rep As Integer
Rep = MsgBox(" Voulez-vous créer un bordereau de facturation pour ce Lot ? ", vbYesNo + vbQuestion, "mDF XLpages.com")
If Rep = vbYes Then
' ici le traitement si réponse positive
'Augmenter rapidité
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Ouvre modèle Facturation Lot (Modèle)
Set Cl = Workbooks.Add("Traitement Cicm\- Modèles\Facturation Lot (Modèle).xlsx")
'Copie les cellules et les cole en valeur au bon endroit
Workbooks("Gestion BRC.xlsm").Sheets("RT").Range("A6:AH1860").Copy
Cl.Sheets("RT").Range("A5").PasteSpecial Paste:=xlPasteValues ', Operation:=xlNone, SkipBlanks
Workbooks("Gestion BRC.xlsm").Sheets("Extraction").Range("G14:G18").Copy
Cl.Sheets("Bord Fin de lot").Range("B15:B19").PasteSpecial Paste:=xlPasteValues ', Operation:=xlNone, SkipBlanks
'Supprime des colones et agrandis une autre
With Cl.Sheets("RT")
.Columns("AE:AF").Delete Shift:=xlToLeft
.Columns("Z:AC").Delete Shift:=xlToLeft
.Columns("Y:Y").ColumnWidth = 60
End With
'Remettre Calcul pour les fonctions suivantes
Application.Calculation = xlCalculationAutomatic
'SUPPRIMER LES LIGNES EN FONCTION DE 1 CASES SUR AUTRE FEUILLE
Cl.Sheets("RT").Select
Set liste = CreateObject("scripting.dictionary")
With Sheets("BORD fin de lot")
For Each C In .[B6]
If C <> 0 Then liste(C.Value) = ""
Next C
End With
For Lig = Cells(Rows.Count, 2).End(xlUp).Row To 5 Step -1
If Cells(Lig, 2) <> "" Then
If Not liste.exists(1 * Cells(Lig, 2)) Then Rows(Lig).EntireRow.Delete
End If
Next Lig
With Cl.Sheets("BORD fin de lot").Select
'Copie des formules
Range("B16").FormulaLocal = "='RT'!$I$5"
Range("E10").Formula = "='RT'!G5"
'Copie feuille BORD fin de lot et la colle au même endroit en valeur
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Enlever le calcul automatique
Application.Calculation = xlCalculationManual
Range("K8:K10").Select
'Séléctionne BORD fin de lot pour mettre en valeur B6 et Enregistre au bon endroit avec la variable en I20
Cl.Sheets("BORD fin de lot").Select
Cl.SaveAs (ThisWorkbook.Path & "\" & "Facturation Lot" & "\" & "Facturation LOT" & " " & [B6].Value & " Nancy CICM - OTI France" & " " & " - " & Format(Date, "yyyy") & ".xlsx")
End With
'Ferme le nouveau fichier
Workbooks("Facturation LOT" & " " & [B6].Value & " Nancy CICM - OTI France" & " " & " - " & Format(Date, "yyyy") & ".xlsx").Close
'Supprime les données sur extraction
Workbooks("Gestion BRC").Sheets("Extraction").Range("I20").Select
Selection.ClearContents
'Arrête les setting
Set Cl = Nothing
'Remettre les paramètres normaux
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox " C'est fini ... le bordereau de facturation est créé ! "
Else
' ici le traitement si réponse négative
End If
'Remettre les paramètres normaux
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Si quelqu'un saurais comment faire ...