Merge Sheets into One Sheet Vba

[rakesh seebaruth]

Hi Guys

I have the following vba as follows :

Private Sub Worksheet_Calculate()

Dim iStr As String
Dim iRng As Range, iCell As Range
Set iRng = ThisWorkbook.Sheets("Input").Range("I2:I" & ThisWorkbook.Sheets("Input").UsedRange.Rows.Count)

For Each iCell In iRng
iStr = Mid(Trim(iCell), 1, 6)
If iStr <> "" Then
If InStr(1, "breach,urgent", iStr, vbTextCompare) > 0 Then
DoEvents
Application.EnableEvents = False
process_data_change iCell
Application.EnableEvents = True
End If
End If
Next

Application.StatusBar = True
End Sub

The above works well . I want to include the below code to the above code

Sub Mergesheet()
Dim sh As Worksheet

Dim DestSh As Worksheet

Dim Last As Long

Dim shLast As Long

Dim CopyRng As Range

Dim StartRow As Long



With Application

.ScreenUpdating = False

.EnableEvents = False

End With



Range("A2:J348").Select

Selection.ClearContents



'Delete the sheet "RDBMergeSheet" if it exist

'Application.DisplayAlerts = False

' On Error Resume Next

'' ActiveWorkbook.Worksheets("Input").Delete

'On Error GoTo 0

'Application.DisplayAlerts = True



'Add a worksheet with the name "RDBMergeSheet"

'Set DestSh = ActiveWorkbook.Worksheets.Add

DestSh.Name = "Input"



'Fill in the start row

StartRow = 2



'loop through all worksheets and copy the data to the DestSh

For Each sh In ActiveWorkbook.Sheets(Array("Input1", "Input2", "Input3"))



'Loop through all worksheets except the RDBMerge worksheet and the

'Information worksheet, you can ad more sheets to the array if you want.

If IsError(Application.Match(sh.Name, _

Array(DestSh.Name, "Statistics", "Documentation", "Legal", "Registration", "Charge", "GSD", "Lease", "SLA", "List", "MailTracking"), 0)) Then



'Find the last row with data on the DestSh and sh

Last = LastRow(DestSh)

shLast = LastRow(sh)



'If sh is not empty and if the last row >= StartRow copy the CopyRng

If shLast > 0 And shLast >= StartRow Then



'Set the range that you want to copy

Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))



'Test if there enough rows in the DestSh to copy all the data

If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then

MsgBox "There are not enough rows in the Destsh"

GoTo ExitTheSub

End If



'This example copies values/formats, if you only want to copy the

'values or want to copy everything look below example 1 on this page

CopyRng.copy

With DestSh.Cells(Last + 1, "A")

.PasteSpecial xlPasteValues

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False

End With



End If



End If

Next



ExitTheSub:



Application.GoTo DestSh.Cells(1)



'AutoFit the column width in the DestSh sheet

DestSh.Columns.AutoFit



With Application

.ScreenUpdating = True

.EnableEvents = True

End With



End Sub

what i want is vba to execute the Sub Mergesheet() into a private sub worksheet first then process to Private Sub Worksheet_Calculate()

Thanks and Regards

rakesh