How do I combine multiple excel sheets into one - taking visible cells only (no formulas)? - excel

Question

I have used the below code but this takes all cells, including formula cells.
I tried to include SpecialCells(xlCellTypeVisible) , but wherever I seem to put it I cannot get it right.
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

Answer 1

Good Morning chaps,
A few days after you asked this questions I was having similar issues with a Macro similar to this Jerry Sullivan
Gave me a hand try this it might work for you.
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
I'm not sure if I understood your question correctly but try this and see if it helps.