在表单列表框中选择多个工作表并将所选合并到新工作表

时间:2017-02-17 12:31:08

标签: excel vba excel-vba

目前,我可以在列表框中选择多个工作表,但是我无法将选定的工作表合并到新工作表中。任何人都可以帮我这个。这是我的代码。

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

1 个答案:

答案 0 :(得分:0)

猜测,因为我不知道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