僅合并Excel中的特定選項卡/作業表

我目前有一個宏可以合并所有選項卡，但名為“組合”的選項卡除外。此組合表將成為合并所有選項卡/表的目的地。但是，我想從組合中排除一些選項卡。

例如，我有 5 個選項卡：組合、tab1、tabA、tab2、tabB。所有選項卡都有相似數量的列/列標題。當我運行宏時，它會將 tab1、tabA、tab2 和 tabB 合并到組合中。我想用我當前的宏修改的是只組合 tab1 和 tabA。我需要如何更改當前的宏？

這是我當前的宏：

Option Explicit
Public Sub CombineDataFromAllSheets()
    Sheets("Combined").Rows("2:" & Sheets("Combined").Rows.Count).ClearContents
    Dim wksSrc As Worksheet, wksDst As Worksheet
    Dim rngSrc As Range, rngDst As Range
    Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
    
    'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
    
    'Set references up-front
    Set wksDst = ThisWorkbook.Worksheets("Combined")
    lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
    lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!
    
    'Set the initial destination range
    Set rngDst = wksDst.Cells(lngDstLastRow   1, 1)
    
    'Loop through all sheets
    For Each wksSrc In ThisWorkbook.Worksheets
    
        'Make sure we skip the "Import" destination sheet!
        If wksSrc.Name <> "Combined" Then
            
            'Identify the last occupied row on this sheet
            lngSrcLastRow = LastOccupiedRowNum(wksSrc)
            
            'Store the source data then copy it to the destination range
            With wksSrc
                Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
                rngSrc.Copy Destination:=rngDst
            End With
            
            'Redefine the destination range now that new data has been added
            lngDstLastRow = LastOccupiedRowNum(wksDst)
            Set rngDst = wksDst.Cells(lngDstLastRow   1, 1)
            
        End If
    
    Next wksSrc

End Sub

uj5u.com熱心網友回復：

用作業表名稱定義一個陣列，然后迭代這個陣列

Dim arrSheets(1) as String
arrSheets(0) = "tab1"
arrSheets(1) = "tabA"

Dim i as long
For i = 0 to Ubound(arrSheets)
    Set wksSrc = Thisworkbook.worksheets(arrSheets(i))
    ....
next

BTW 1：避免隱式參考作業表和范圍 - 始終使用顯式參考，例如thisworkbook.worksheets或wksSrc.range(...)

BTW 2：您不需要復制/粘貼 - 只需將值寫入目標：

With rngSrc 
    rngDst.Resize(.Rows.Count, .Columns.Count).Value = .Value 'this is much faster and you don't need the clipboard
End With

uj5u.com熱心網友回復：

@Ike 提供了一個很好的答案。他們和我的想法是同一想法的兩種變體：創建要處理的作業表串列，然后回圈遍歷該串列而不是遍歷作業簿中的所有作業表。

我還清理了一些其他部分以更好地實作這個新想法。這是修改后的代碼：

Option Explicit
Public Sub CombineDataFromAllSheets()
    Dim wksSrc As Variant, wksDst As Worksheet
    Dim rngSrc As Range, rngDst As Range
    Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
    Dim SourceSheets As Variant
    'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
    
    'Set references up-front
    Set wksDst = ThisWorkbook.Worksheets("Combined")
    lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
    lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!
    
    'List of sheets to operate on
    SourceSheets = Array( _
                     ThisWorkbook.Worksheets("tab1"), _
                     ThisWorkbook.Worksheets("tabA") _
                   )
            
    wksDst.Rows("2:" & Sheets("Combined").Rows.Count).ClearContents
    
    'Set the initial destination range
    Set rngDst = wksDst.Cells(lngDstLastRow   1, 1)
    
    'Loop through all sheets
    For Each wksSrc In SourceSheets
            
        'Identify the last occupied row on this sheet
        lngSrcLastRow = LastOccupiedRowNum(wksSrc)
        
        'Store the source data then copy it to the destination range
        With wksSrc
            Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
            rngSrc.Copy Destination:=rngDst
        End With
        
        'Redefine the destination range now that new data has been added
        lngDstLastRow = LastOccupiedRowNum(wksDst)
        Set rngDst = wksDst.Cells(lngDstLastRow   1, 1)
            
    
    Next wksSrc

End Sub

標籤：擅长 vba

上一篇：確定行中的相等值

下一篇：使用ExcelVBADir()函式回圈并打開檔案目錄提前退出