如何将多个excel工作表合并为一个-仅使用可见单元格（无公式）？

我使用了下面的代码，但这需要所有单元格，包括公式单元格

我试图包括

特殊单元格（xlCellTypeVisible）

，但无论我放在哪里，我都无法正确地得到它

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

各位早上好

在你问了这个问题几天后，我对类似的宏也有类似的问题

帮我试试这个也许对你有用

Option Explicit

Sub CombineData()
'--combines data from all sheets
'  assumes all sheets have exact same header fields as the
'    first sheet; however the fields may be different order.
'--combines using copy-paste. could be modified to pasteValues only

 Dim lNdxSheet As Long, lNextRow As Long, lDestCol As Long
 Dim lColCount As Long, lRowCount As Long
 Dim rHeaders As Range
 Dim sHeader As String
 Dim vMatch As Variant, vHeaders As Variant
 Dim wksCombined As Worksheet

 With Application
   .ScreenUpdating = False
   .DisplayAlerts = False
 End With

 '--add new sheet for results
 Set wksCombined = Worksheets.Add(Before:=Worksheets(1))

 '--optional: delete existing sheet "Combined"
 On Error Resume Next
 Sheets("Combined").Delete
 On Error GoTo 0

 With wksCombined
   .Name = "Combined"
   '--copy headers that will be used in destination sheet
   Set rHeaders = Sheets(2).Range("A1").CurrentRegion.Resize(1)
   rHeaders.Copy Destination:=.Range("A1")
 End With
 '--read headers into array
 vHeaders = rHeaders.Value
 lColCount = UBound(vHeaders, 2)
 lNextRow = 2

 For lNdxSheet = 2 To Sheets.Count
   '--count databody rows of continguous dataset at A1
   lRowCount = Sheets(lNdxSheet).Range("A1").CurrentRegion.Rows.Count - 1
   If lRowCount > 0 Then
      For lDestCol = 1 To lColCount
         sHeader = vHeaders(1, lDestCol)
         '--search entire first col in case field is rSourceData
         vMatch = Application.Match(sHeader, Sheets(lNdxSheet).Range("1:1"), 0)

         If IsError(vMatch) Then
            MsgBox "Header: """ & sHeader & """ not found on sheet: """ _
               & Sheets(lNdxSheet).Name
            GoTo ExitProc
         End If
         With Sheets(lNdxSheet)
         '--copy-paste this field under matching field in combined
           .Cells(2, CLng(vMatch)).Resize(lRowCount).Copy
           '  Option 1: paste values only
           wksCombined.Cells(lNextRow, lDestCol).PasteSpecial (xlPasteValues)

           '  Option 2: paste all including formats and formulas
           '  wksCombined.Cells(lNextRow, lDestCol).PasteSpecial (xlPasteAll)  
        End With
      Next lDestCol
      lNextRow = lNextRow + lRowCount
   End If ' lRowCount > 0

 Next lNdxSheet
ExitProc:
 With Application
   .ScreenUpdating = True
   .DisplayAlerts = True
 End With

End Sub

---

我不确定是否正确理解了您的问题，但请尝试一下，看看是否有帮助。

欢迎使用堆栈溢出。请阅读并找出如何提出一个好的问题，从而得到好的、有用的答案。