当我们运行一个macros时，如何避免一个表单将来自多个工作表的数据合并到一个工作表中

我是新来的macros，但有一些基本的想法是如何工作，或像写能够写VBA的小代码。

是否可以避免超过1张，当我使用下面的macros，实际上从不同的工作表复制数据到一张名为导入表

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。 控制表（更像是仪表板/用户界面）
Sheet2中。 导入（数据需要复制的地方）
表Sheet 3。 比较（无需复制此表中的数据）
Sheet4。 CSV文件1（所有可用数据将被复制到IMPORT表格）
Sheet5。 CSV文件2（所有可用数据将被复制到IMPORT表单）

现在，当用户运行查询时，仅将来自工作表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范围传递给一个辅助函数。 这使得debugging非常简单。

 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