Excel VBA:将多个工作表合并为一个 [英] Excel VBA: combine multiple worksheets into one

问题描述

我使用以下代码来组合多个工作表.问题是，此代码适用于第一行中具有标题的工作表，而我的工作表中没有.只能选择3列(A，F和G).工作表具有相同的结构，只是行数可以不同.任何想法?谢谢！

I use the following code to combine multiple worksheets. The problem is, that this code works with worksheets that have title in the first row and my worksheets do not have. It is possible to select only 3 columns (A, F and G).. I mean the range from the woorksheets? The worksheets have the same structure only the number of lines may be different. Any idea? Thanks!

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

推荐答案

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

Instead of copying only A, F+G you can delete all columns you don't need from the resulting sheet.

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:将多个工作表合并为一个的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！