Membuat Rekap Multy sheet sesuai pilihan di Listbox - Belajar VBA Excel

Function pilihcopy() As Integer

 pilihcopy = 0

     If lstSheets.ListCount > 0 Then

         For k = 0 To lstSheets.ListCount - 1

    If lstSheets.Selected(k) Then

        pilihcopy = pilihcopy + 1

        End If

        Next

        End If

        End Function

Private Sub CommandButton1_Click()

    Dim Satukandata As Worksheet

    Dim dataCopyl      As Range

    Dim Sheets_baru As String

     Sheets_baru = Me.Nama_sheet_baru

If Sheets_baru = "" Then

        MsgBox "Ketik nama sheet baru"

        Me.Nama_sheet_baru.SetFocus

        Exit Sub

    End If

    On Error Resume Next

 Set Satukandata = Sheets.Add(after:=Sheets(5))

    Satukandata.Name = Sheets_baru

    If Err = 1004 Then

        MsgBox Err.Description

        Application.DisplayAlerts = False

        ActiveSheet.Delete

        Application.DisplayAlerts = True

        Exit Sub

    End If

    On Error GoTo 0

    Set dataCopyl = Satukandata.Cells(1, 1)

    For k = 0 To lstSheets.ListCount - 1

        If lstSheets.Selected(k) Then

            Sheets(lstSheets.List(k)).Select

            Sheets(lstSheets.List(k)).Cells.SpecialCells(xlLastCell).Select

            Range(Selection, Cells(1, 1)).Select

            Selection.Copy

            Satukandata.Select

            dataCopyl.Select

            Satukandata.Paste

            Selection.PasteSpecial Paste:=xlPasteValues

            Selection.SpecialCells(xlLastCell).Select

            Set dataCopyl = Satukandata.Cells(ActiveCell.Row + 1, 1)

    End If

    Next

    Unload Me

End Sub

 Private Sub CommandButton2_Click()

Dim Cnt As Long, i As Long

Cnt = Sheets.Count

Application.DisplayAlerts = False

     For i = Cnt - 0 To 6 Step -1

          Sheets(i).Delete

     Next i

Application.DisplayAlerts = True

End Sub

Private Sub UserForm_Initialize()

    For k = 1 To Sheets.Count

        lstSheets.AddItem Sheets(k).Name

    Next

   End Sub

UNDUH CONTOH FILE XLSM >>>>>>>    Rekap multy Sheet

Demikian semoga bermanfaat!!!