Liebe Forumsmitglieder, 

Ich bin neu hier und wäre euch sehr dankbar, wenn Ihr einem VBA Neuling bei folgendem Problem helfen könntet: 

In Excel soll per Command Button eine ListBox aktiviert werden, mit welcher mit Ausnahme des ersten Blattes die vorhandenen Tabellenblätter ausgewählt, kopiert, zusammengefügt und in einer neuen Mappe gespeichert werden können. 
Es handelt sich bei der Datei um einzelne Punkte einer Checkliste, welche je nach zu prüfendem Thema zusammengestellt werden kann, wobei die einzelnen Prüfpunkte eben in jenen Tabellenblättern enthalten sind. 

Mein Makro sieht bis jetzt so aus: 

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 
Next 
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("A:A").Rows.AutoFit 
Columns("B:B").WrapText = True 
Columns("B:B").ColumnWidth = 10 
Columns("B:B").Rows.AutoFit 
Columns("C:C").WrapText = True 
Columns("C:C").ColumnWidth = 74 
Columns("C:C").Rows.AutoFit 
Columns("D:D").WrapText = True 
Columns("D:D").ColumnWidth = 8 
Columns("D:D").Rows.AutoFit 
Columns("E:E").WrapText = True 
Columns("E:E").ColumnWidth = 8 
Columns("E:E").Rows.AutoFit 
Columns("F:F").WrapText = True 
Columns("F:F").ColumnWidth = 8 
Columns("F:F").Rows.AutoFit 
Columns("G:G").WrapText = True 
Columns("G:G").ColumnWidth = 34 
Columns("G:G").Rows.AutoFit 
End With 
Msg = Msg & Me.ListBox2.List(intSh) & vbCr 
Unload Me 

Next i 

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

Next 

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 
Next 

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 
Next 
End Sub 

Leider wird bis jetzt nur ein neues jedoch leeres Tabellenblatt mit Namen "Completed Checklist" sowie eine neue Arbeitsmappe mit dem ersten Tabellenblatt erstellt. 

Ich hoffe Ihr könnt mir hierbei helfen. 

Vielen Dank im Voraus!