Switch classeur actif

Chrys

XLDnaute Nouveau
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.

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
 

Discussions similaires

Statistiques des forums

Discussions
312 276
Messages
2 086 714
Membres
103 377
dernier inscrit
fredy45