How can the data copied to the consolidated sheet be pasted as values, currently works but where formulas are present these are copied over as is when in fact its the result needed from the initial sheet that needs to be taken.
An additional mod is also needed to only copy from row 2 on each entry sheet to the consolidated data tab.
Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet()
On Error GoTo IfError
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True
With ActiveWorkbook
Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
DstSht.Name = "Consolidate_Data"
End With
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> DstSht.Name Then
DstRow = fn_LastRow(DstSht)
LstRow = fn_LastRow(Sht)
LstCol = fn_LastColumn(Sht)
EnRange = Sht.Cells(LstRow, LstCol).Address
Set SrcRng = Sht.Range("A1:" & EnRange)
If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
GoTo IfError
End If
SrcRng.Copy Destination:=DstSht.Range("A" & DstRow + 1)
End If
Next
DstSht.Range("A1") = "X"
IfError:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Function fn_LastRow(Sht As Worksheet)
Dim lastRow As Long
lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
lRow = Sht.Cells.SpecialCells(xlLastCell).Row
Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
lRow = lRow - 1
Loop
fn_LastRow = lRow
End Function
Function fn_LastColumn(Sht As Worksheet)
Dim lastCol As Long
lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
lCol = Sht.Cells.SpecialCells(xlLastCell).Column
Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
lCol = lCol - 1
Loop
fn_LastColumn = lCol
End Function
Tried adding:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False