在運行宏時如何避免出現一張紙將多張紙中的數據合並為一張紙的情況

Question

我是宏的新手，但是對宏的工作原理有一些基本了解，或者喜歡能夠編寫小的VBA代碼。

當我使用下面的宏將實際將數據從不同的表復制到一張稱為導入的宏時，是否可以避免超過一張紙？

VBA代碼

Option Explicit
Public Sub CombineDataFromAllSheets()

Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
Dim Strname As String

'Notes: "Src" is short for "Source", "Dst" is short for "Destination"

'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("Import")
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!
    Strname = UCase(wksSrc.Name)
    If Strname <> "Import" And _
    Strname <> "Import2" 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


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last column
'OUTPUT      : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    LastOccupiedColNum = lng
End Function

例如我在一個Excel中有5張紙，它們是

工作表Sheet1。 控制表（更像是儀表板/ UI）
Sheet2中。 導入（需要復制數據的地方）
表Sheet 3。 比較（無需復制此工作表中的數據）
Sheet4。 CSV文件1（所有可用數據將復制到“導入”表）
Sheet5。 CSV文件2（所有可用數據將復制到“導入”表）

現在，當用戶運行查詢時，僅將工作表5和工作表6中的數據復制到工作表2中（導入）

我用了

Strname = UCase(wksSrc.Name)
If Strname <> "Import" And _
Strname <> "Comparison" And _ 
Strname <> "Control Sheet" Then

但這實際上不起作用，僅復制所有5張紙下的所有內容。

請幫助我。

提前致謝

Answer 1

Select Case語句非常適合處理多個比較值。

    Select Case UCase(wksSrc.Name)
        Case UCase("Import"), UCase("Comparison"), UCase("Control Sheet")

        Case Else

    End Select

---

在這里，我使用Filter來進行文本比較。

我更喜歡將Source范圍傳遞給一個輔助函數。 這使得調試非常容易。

Public Sub CombineDataFromAllSheets2()
    Dim LastUsedCell As Range, ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        With ws
            If Filter(Array("Import", "Comparison", "Control Sheet"), .Name, True, vbTextCompare) = -1 Then

                Set LastUsedCell = getLastUsedCell(ws)
                If LastUsedCell Is Nothing Then
                    MsgBox "No Cells Found on Worksheet: " & ws.Name, vbInformation, "Worksheet Skipped"
                Else
                    ImportRange .Range(.Cells(2, 1), LastUsedCell)
                End If

            End If
        End With
    Next
End Sub

Public Sub ImportRange(Source As Range)
    With ThisWorkbook.Worksheets("Import")
        With .Range("A" & .Rows.Count).End(xlUp)
            Source.Copy Destination:=.Offset(1)
        End With
    End With
End Sub

Public Function getLastUsedCell(ws As Worksheet) As Range
    Set getLastUsedCell = ws.Cells.Find(What:="*", After:=ws.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
End Function