Bonjour le forum,
N'étant pas très doué avec VBA, je me dépatouille toujours au cas par cas en m'aidant ici et là (surtout ici).
j'ai donc reussis à me dépatouiller avec le code ci dessous pour copier quelques élements d'une feuille dans un nouveau classeur (afin de creer une version light de mes devis/bons de commandes, sans formules et tout et tout ...)
Seul souci, arrivé à la fin j'aimerais re switcher sur le premier classeur afin de supprimer ce que j'ai copié dans la feuille Light en début de macro (D2, D6, D8....), seul souci, ca me les supprime toujours dans le nouveau classeur que je viens de créé et non dans l'ancien.
Merci d'avance pour votre aide.
Si vous voyez un moins d'améliorer ce code n'hésitez pas à me faire part de vos critiques/suggestions.
Encore merci,
Chrys
N'étant pas très doué avec VBA, je me dépatouille toujours au cas par cas en m'aidant ici et là (surtout ici).
j'ai donc reussis à me dépatouiller avec le code ci dessous pour copier quelques élements d'une feuille dans un nouveau classeur (afin de creer une version light de mes devis/bons de commandes, sans formules et tout et tout ...)
Seul souci, arrivé à la fin j'aimerais re switcher sur le premier classeur afin de supprimer ce que j'ai copié dans la feuille Light en début de macro (D2, D6, D8....), seul souci, ca me les supprime toujours dans le nouveau classeur que je viens de créé et non dans l'ancien.
Code:
Sub Xlslight()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePathxls As String
Dim TempFileNamexls As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
TempFilePathxls = Environ$("temp") & "\"
Sheets("Light").Range("D2") = Sheets("Devis").Range("D2")
Sheets("Light").Range("D6") = Sheets("Devis").Range("D6")
Sheets("Light").Range("D8") = Sheets("Devis").Range("D8")
Sheets("Light").Range("D10") = Sheets("Devis").Range("D10")
Sheets("Light").Range("D12") = Sheets("Devis").Range("D12")
Sheets("Light").Range("E10") = Sheets("Devis").Range("E10")
Sheets("Light").Range("E12") = Sheets("Devis").Range("E12")
Sheets("Light").Range("E15") = Sheets("Devis").Range("E15")
Sheets("Light").Range("E16") = Sheets("Devis").Range("E16")
Sheets("Light").Range("E17") = Sheets("Devis").Range("E17")
Sheets("Light").Range("E19") = Sheets("Devis").Range("E19")
Sheets("Devis").Range("A21:G53").Copy
Sheets("Light").Activate
Range("A21").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
If Sheets("Light").Range("F" & [M1].Value) = 0 Then
Rows([M1].Value).EntireRow.Hidden = True
End If
'Copie commande vers nouveau classeur
Sheets("Light").Copy
Set Destwb = ActiveWorkbook
With Destwb
If Val(Application.Version) < 12 Then
'Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'Excel 2007-2013
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
utilisateur = Environ("username")
TempFilePathxls = "C:\Users\" & utilisateur & "\Desktop\"
TempFileNamexls = [D6].Value & "_" & [D2].Value '& Format(Now, "dd-mmm-yy")
With Destwb
.SaveAs TempFilePathxls & TempFileNamexls & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Merci d'avance pour votre aide.
Si vous voyez un moins d'améliorer ce code n'hésitez pas à me faire part de vos critiques/suggestions.
Encore merci,
Chrys