Copie ligne suite à sélection dans ListBox

Hello tout le monde,

Tout d'abord merci beaucoup d'avance pour l'aide que vous pourrez m'apporter.

Je suis embêté par un problème qui, je l'imagine, est en réalité très simple à résoudre.

Dans une première feuille, j'ai une liste de données ainsi qu'un userform. Ce userform va faire apparaître les données de la première colonne de la liste. Ce que je cherche à faire est, une fois la sélection faite, de copier la ligne où la donnée apparaît vers une deuxième feuille. Mais le code que j'ai essayé de développer ne fonctionne pas....

Sub Copy_With_AutoFilter1()

    Dim My_Range As Range
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim FilterCriteria As String
    Dim CCount As Long
    Dim WSNew As Worksheet
    Dim sheetName As String
    Dim rng As Range

    Set My_Range = Range("A11:G" & LastRow(ActiveSheet))
    My_Range.Parent.Select

    If ActiveWorkbook.ProtectStructure = True Or _
       My_Range.Parent.ProtectContents = True Then
        MsgBox "La macro la macro ne peut marcher si le classeur est protégé", _
               vbOKOnly, "Copier vers un nouveau classeur"
        Exit Sub
    End If

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    ActiveSheet.DisplayPageBreaks = False

    My_Range.Parent.AutoFilterMode = False

    My_Range.AutoFilter Field:=1, Criteria1:="=Prix d'ambiance"

        Set WSNew = Worksheets.Add(After:=Sheets(ActiveSheet.Index))

        sheetName = InputBox("Quel est le nom du nouveau classeur?", _
                             "Nommer le nouveau classeur")

        My_Range.Parent.AutoFilter.Range.Copy
        With WSNew.Range("A1")
            .PasteSpecial Paste:=8
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            .Select
        End With

    My_Range.Parent.AutoFilterMode = False

    My_Range.Parent.Select
    ActiveWindow.View = ViewMode
    If Not WSNew Is Nothing Then WSNew.Select
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With

End Sub

Ci après le code du userform :

Private Sub UserForm_Initialize()

ListBox1.List() = Workbooks("CA _2nd semestre 2016.xlsx").Worksheets("CA 2nd semestre 2016").Range("A3:A40").Value

End Sub

A nouveau un grand merci à celles et ceux qui me permettront de progresser !

arochab

Rechercher des sujets similaires à "copie ligne suite selection listbox"