在表單列表框中選擇多個工作表並將選定合併到新工作表

Question

目前，我可以在列表框中選擇多個工作表，但是我無法將選定工作表合併到新工作表中。任何人都可以幫助我這個。這是我的代碼。

Private Sub CommandButton1_Click() 

    Dim i As Integer 
    Dim wrk As Workbook 
    Dim sht As Worksheet 
    Dim Rng As Range 
    Dim colCount As Integer 

    Set wrk = ActiveWorkbook 

    For i = 0 To ListBox1.ListCount - 1 
     If ListBox1.Selected(i) Then 


Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 
Set sht = ListBox1.List(i) 

For Each sht In ListBox1 
If sht.Index = wrk.Worksheets.Count Then 
Exit For 
End If 

Set Rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value 
Next sht 
trg.Columns.AutoFit 

     End If 
    Next i 

End Sub 


Private Sub UserForm_Activate() 

For n = 1 To ActiveWorkbook.Sheets.Count 
With ListBox1 
    .AddItem ActiveWorkbook.Sheets(n).Name 
End With 
Next n 

End Sub 

Answer 1

有所猜測，因爲我不知道colCount價值的一件事

Private Sub CommandButton1_Click() 

Dim i As Integer 
Dim wrk As Workbook 
Dim sht As Worksheet 
Dim Rng As Range 
Dim colCount As Integer 
Dim trg As Worksheet 

Set wrk = ActiveWorkbook 
colCount = 4 
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 

For i = 0 To ListBox1.ListCount - 1 
    If ListBox1.Selected(i) Then 
     Set sht = Sheets(ListBox1.List(i)) 
     With sht 
      Set Rng = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Resize(, colCount)) 
     End With 
     trg.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Rng.Value 
     trg.Columns.AutoFit 
    End If 
Next i 

End Sub