Question

我使用以下代码来组合多个工作表。问题是，此代码适用于第一行具有标题的工作表，而我的工作表则没有。只能选择3列（A，F和G）。.我是说从woorksheets的范围？工作表具有相同的结构，只是行数可以不同。任何想法？谢谢！

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"
' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
' work through sheets
For J = 2 To Sheets.Count ' from sheet 2 to last sheet
    Sheets(J).Activate ' make the sheet active
    Range("A1").Select
    Selection.CurrentRegion.Select ' select all cells in this sheets
    ' select all lines except title
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
    ' copy cells selected in the new sheet on last line
    Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

Answer 1

您可以从结果表中删除不需要的所有列，而不是仅复制A，F + G。

Sub Combine()
Dim jCt As Integer
Dim ws As Worksheets
Dim myRange As Range
Dim lastRow As Long
lastRow = 1

'Delete Worksheet combine if it exists
If sheetExists("Combined") Then
    Application.DisplayAlerts = False
    Sheets("Combined").Delete
    Application.DisplayAlerts = True
    MsgBox "Worksheet ""Combined"" deleted!"
End If

Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"

' work through sheets
For jCt = 2 To Sheets.Count ' from sheet 2 to last sheet

    Set myRange = Sheets(jCt).Range(Sheets(jCt).Cells(1, 1), Sheets(jCt).Range("A1").SpecialCells(xlCellTypeLastCell))
    Debug.Print Sheets(jCt).Name, myRange.Address

    'Put the SheetName on the Sheet "Cominbed"
    Sheets("Combined").Range("A1").Offset(lastRow, 0) = Sheets(jCt).Name
    With Sheets("Combined").Range("A1").Offset(lastRow, 0).Font
        .Bold = True
        .Size = 14
    End With

    'copy the sheets
    myRange.Copy Destination:=Sheets("Combined").Range("A1").Offset(lastRow + 2, 0)
    lastRow = lastRow + myRange.Rows.Count + 3

Next
End Sub


Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

Excel VBA：将多个工作表合并为一个

1 个答案: