Transfert du contenu des colonnes en créan un autre classeur

bonjour a tous

j'ai un classeur que je reçois par mail tous les mois, mais je n'ai pas besoin du contenu de certaines colonnes mais mon associé oui

donc ce que je voudrais c'est pourvoir copier certaines colonnes comme B:D;F;K et les transférer dans un classeur qui sera créer en même temps dans un sous-dossier sur le bureau nommé test dans le dossier essai et que l'on nommera DONNEES

j'espère que mon explication tient la route sinon n'hésiter pas

Pascal

Salut :

Sub sCopy_To_NewBook()

Dim Last As Long, i As Long, sh As Worksheet, NewBook As Workbook, Destination As String, Folder As String

'-------------------------------------------------------------------

Folder = ThisWorkbook.Path & "\DONNEES"

On Error GoTo 1

If Not Folder = "" Then MkDir Folder

1

'-------------------------------------------------------------------

Destination = Folder & "\test.xlsx"

'-------------------------------------------------------------------

Set NewBook = Workbooks.Add

Set sh = ThisWorkbook.ActiveSheet

'-------------------------------------------------------------------

Application.ScreenUpdating = False

With sh

Last = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row

For i = 1 To Last

Union(.Range("B" & i), .Range("D" & i), .Range("F" & i), .Range("K" & i)).Copy

NewBook.Sheets(1).Range("A" & i).PasteSpecial (xlPasteValues)

Next

End With

With NewBook

.SaveAs Filename:=Destination: .Close

End With

Application.ScreenUpdating = True

End Sub

bonsoir belkacem64

merci de ta réponse, cela fonctionne mais ce n'est pas tout a fait cela que j'attendai

je reçois un dossier avec une feuille excel, ce n'est pas dans ce dossier que doit se créer la feuille mais dans celui qui est sur le bureau et qui se nomme test dans lequel il y a une feuille DONNEES

Pascal