VBA supprimer classeur
Bonjour
J'ai enfin réussi a faire ma macro qui travaille comme je le veux. Il me reste juste une chose à faire: Supprimer le classeur sur lequel j'ai travaillé car il a été renommé et enregistré au préalable autre part
Il faudrait donc que je trouve comment supprimer le fichier wb2 aprés l'avoir enregistré à un autre endroit. La grosse difficulté est que je ne donne pas le nom de ce fichier je l'ouvre directement à partir du répertoire
Sub Ouvrir_Fichiers()
If Range("D8").Value = "" Then
MsgBox " Impossible de traiter le fichier car le numéro de semaine n'est pas saisie ! "
Exit Sub
End If
' Permet d'ouvrir plusieurs fichiers dans un répertoire
' GC Excel - 2011-11-16
Dim wb As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook
Dim sPath As String, sFilename As String
Dim NbRows As Integer, rg As Range
Set wb = ThisWorkbook
Dim Rep As Integer
Rep = MsgBox(" ATTENTION : Avant de traiter le fichier, avez-vous choisit la bonne semaine ? ", vbYesNo + vbQuestion, "Avertissement")
If Rep = vbYes Then
' ici le traitement si réponse positive
'Augmenter rapidité
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
sPath = "C:\Users\Utilisateur\Desktop\Suivi Véolia\Fichier a traiter\" 'Répertoire
sFilename = Dir(sPath & "*.xls*") 'ouvre tous les fichiers .xls*
Do While Len(sFilename) > 0
Set wb2 = Workbooks.Open(sPath & sFilename) 'Ouvre le fichier
'
' Votre code ici
wb.Sheets("Traitement").Range("D8").Copy
wb2.Sheets("Feuil2").Range("IV1").PasteSpecial Paste:=xlPasteValues ', Operation:=xlNone, SkipBlanks
wb.Sheets("Traitement").Range("D8").ClearContents
Set wb3 = Workbooks.Open(ThisWorkbook.Path & "\" & "Global" & "\" & "RT 2017.xlsx")
'Essais ligne par ligne ca marche mais les lignes pourraient être décalé et ca me l'amene Ligne 2 a chaque fois
wb2.Sheets("Feuil2").Range("A2:A2000").Copy wb3.Sheets("RT").Range("A1000000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("G2:G2000").Copy wb3.Sheets("RT").Range("B1000000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("J2:J2000").Copy wb3.Sheets("RT").Range("C1000000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("K2:K2000").Copy wb3.Sheets("RT").Range("D1000000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("L2:L2000").Copy wb3.Sheets("RT").Range("E1000000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("V2:V2000").Copy wb3.Sheets("RT").Range("F1000000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("X2:X2000").Copy wb3.Sheets("RT").Range("G1000000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("Y2:Y2000").Copy wb3.Sheets("RT").Range("H1000000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("Z2:Z2000").Copy wb3.Sheets("RT").Range("I10000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("AB2:AB2000").Copy wb3.Sheets("RT").Range("K10000").End(xlUp)(2)
wb2.Sheets("Feuil2").Range("AC2:AC2000").Copy wb3.Sheets("RT").Range("J10000").End(xlUp)(2)
With wb3.Sheets("RT")
Rows("1:1").Copy Rows("1000000").End(xlUp)(2)
End With
'Remettre les paramètres normaux
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = False
wb3.Save
wb3.Close 'Fermer le fichier
Application.DisplayAlerts = True
'Séléctionne BORD fin de lot pour mettre en valeur B6 et Enregistre au bon endroit avec la variable en I20
With wb2.Sheets("Feuil2")
wb2.SaveAs (ThisWorkbook.Path & "\" & "RT Véolia" & "\" & "RT Véolia S " & [IV1].Value & ".xls")
'Ferme le nouveau fichier
Workbooks("RT Véolia S " & [IV1].Value & ".xls").Close
End With
sFilename = Dir
Loop
Set wb = Nothing
MsgBox " C'est fini ... Vous pouvez désormais supprimer le fichier placé dans Fichier a traiter en toute sérénité ! "
Else
' ici le traitement si réponse négative
End If
'Remettre les paramètres normaux
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Pourriez vous m'aider SVP ça deviens urgent !!!!