Question

我需要将多个工作表合并到一个工作表中，同时在合并信息的每个选项卡之间留有空格。有人能帮忙吗？下面是我的代码，但我遗漏了一些东西：

Sub CopyWorksheets()
    Dim wrk As Workbook
    Dim sht As Worksheet
    Dim trg As Worksheet
    Dim rng As Range
    Dim colCount As Integer

    Set wrk = ActiveWorkbook 'Working in active workbook

    For Each sht In wrk.Worksheets
        If sht.Name = "Master" Then
            MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
            "Please remove or rename this worksheet since 'Master' would be" & _
            "the name of the result worksheet of this process.", _
                                  vbOKOnly + vbExclamation, "Error"
            Exit Sub
        End If
    Next sht

     'We don't want screen updating
    Application.ScreenUpdating = False

     'Add new worksheet as the last worksheet
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
     'Rename the new worksheet
    trg.Name = "Master"
     'Get column headers from the first worksheet
     'Column count first
    Set sht = wrk.Worksheets(1)
    colCount = sht.Cells(1, 255).End(xlToLeft).Column
     'Now retrieve headers, no copy&paste needed
    With trg.Cells(1, 1).Resize(1, colCount)
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value
         'Set font as bold
        .Font.Bold = True
    End With

     'We can start loop
    For Each sht In wrk.Worksheets
      'If worksheet in loop is the last one, stop execution (it is Master worksheet)
        If sht.Index = wrk.Worksheets.Count Then
            Exit For
        End If
         'Data range in worksheet - starts from second row as 
         'first rows are the header rows in all worksheets
        Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
         'Put data into the Master worksheet
        trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, _
                                  rng.Columns.Count).Value = rng.Value
'move cursor to bottom on active range and insert row
        Range("A65536").End(xlUp).Offset(1, 0).Select
        Selection.Offset(1, 0).Select
    Next sht
     'Fit the columns in Master worksheet
    trg.Columns.AutoFit

     'Screen updating should be activated
    Application.ScreenUpdating = True
End Sub

Answer 1

也许这就是你所需要的：

For Each sht In wrk.Worksheets

    If sht.Index = wrk.Worksheets.Count Then Exit For

    Set rng = sht.Range(sht.Cells(2, 1), _
                        sht.Cells(rows.count, 1).End(xlUp).Resize(, colCount))

    'Put data into the Master worksheet (skip one empty row)
    trg.Cells(rows.count, 1).End(xlUp).Offset(2).Resize(rng.Rows.Count, _
                                  rng.Columns.Count).Value = rng.Value

Next sht

VBA将多个工作表合并为一个，并在每个工作表之间插入一行

1 个答案: