Dear Community,

I'm new to this forum and I hope you can help an excel VBA newbie with the following problem:

In Excel 2010 a listbox is activated via Command Button which enables the selection of the worksheets by worksheet name (except the first sheet). Then, the selected sheets should be copied and merged into a new workbook which should automatically be saved under a specified path.
The file contains items from a checklist which can be compiled together depending on the subject to be checked. Those items are contained in the concerned worksheets.

So far my marcro looks like this:

Option Explicit

Private Sub CmdCancel2_Click()
Unload Me
End Sub

Private Sub CmdSelect2_Click()

Dim intSh As Integer
Dim Msg As String
Dim wks As Worksheet
Dim strLC As String
Dim Range As Range
Dim wb As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim i As Integer
Dim r As Object

Application.ScreenUpdating = False

Set wks = Worksheets.Add
wks.Name = "Completed Checklist"

On Error Resume Next

For Each ws In wb.Worksheets
If Me.ListBox2.ListCount > 0 Then
For intSh = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Selected(intSh) Then
Sheets(intSh + 1).Copy
Msg = Msg & Me.ListBox2.List(intSh) & vbCr
Unload Me
End If
End If

For i = 2 To Worksheets.Count
With Sheets(i).UsedRange
strLC = .Cells(.Rows.Count, .Columns.Count).Address
Set Range = .Range("A1:" & strLC)
Range.Copy Destination:= _
wks.Cells(Rows.Count, 1).End(xlUp)
Columns("A:A").WrapText = False
Columns("A:A").ColumnWidth = 8
Columns("B:B").WrapText = True
Columns("B:B").ColumnWidth = 10
Columns("C:C").WrapText = True
Columns("C:C").ColumnWidth = 74
Columns("D:D").WrapText = True
Columns("D:D").ColumnWidth = 8
Columns("E:E").WrapText = True
Columns("E:E").ColumnWidth = 8
Columns("F:F").WrapText = True
Columns("F:F").ColumnWidth = 8
Columns("G:G").WrapText = True
Columns("G:G").ColumnWidth = 34
End With
Msg = Msg & Me.ListBox2.List(intSh) & vbCr
Unload Me

Next i

For Each r In ActiveSheet.UsedRange.Rows
If r.RowHeight < 25 Then r.RowHeight = 25


With ActiveSheet.PageSetup
.Orientation = xlLandscape
.Zoom = 85
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

Application.ScreenUpdating = True

MsgBox "The following paragraphs have been listed in your checklist: " & vbCr & vbCr & Msg

End Sub

Private Sub Label1_Click()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
Dim intI As Integer

For intI = 2 To Worksheets.Count
Me.ListBox2.AddItem Worksheets(intI).Name
End Sub

Unfortunately, the only thing which happens so far is that a new but empty sheet with the name "Completed Checklist" is opened within the existing workbook and a new workbook is being generated with the first sheet copied from the original book.

I really hope you can help me with this.

Thank you very much in advance!

Greetings from Switzerland