P
Priyanka
Sorry-part of the code got truncated suring copy paste-here is the
full macro
Public RunWhen As Double
Public Const cRunIntervalSeconds = 900 ' two minutes
Public Const cRunWhat = "CopyDataMacro" ' the name of the procedure
to run
Dim Sht1RowCount, Sht1ColCount As Long
Public Sub Adder()
Worksheets.Add.Name() = "Sheet2"
'Calculate size of input
Sheets("Monitor").Select
Sht1RowCount = ActiveSheet.UsedRange.Rows.Count
Sht1ColCount = ActiveSheet.UsedRange.Columns.Count
Range(Cells(5, 1), Cells(5, Sht1ColCount)).Select
Range(Cells(5, 1), Cells(5, Sht1ColCount)).Copy
'Initiate Sheet2
'Copy header row from Monitor to initiate
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(1, Sht1ColCount)).Select
ActiveSheet.Paste
CopyDataMacro
End Sub
Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=True
End Sub
Sub CopyDataMacro()
'Select data rows from Monitor sheet
Sheets("Monitor").Select
Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Select
Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Copy
'Determine input in Sheet2 sheet
Sheets("Sheet2").Select
Dim LastRow, LastColumn As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
'Paste in Sheet2 Sheet
Range(Cells(LastRow + 1, 1), Cells(LastRow + Sht1RowCount - 1,
Sht1ColCount)).Select
Selection.PasteSpecial Paste:=xlValues
Cells(LastRow + 1, 1) = Time
'Save data
If ActiveWorkbook.Saved = False Then
ActiveWorkbook.Save
End If
' Call StartTimer to schedule the procedure
StartTimer
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=False
End Sub
full macro
Public RunWhen As Double
Public Const cRunIntervalSeconds = 900 ' two minutes
Public Const cRunWhat = "CopyDataMacro" ' the name of the procedure
to run
Dim Sht1RowCount, Sht1ColCount As Long
Public Sub Adder()
Worksheets.Add.Name() = "Sheet2"
'Calculate size of input
Sheets("Monitor").Select
Sht1RowCount = ActiveSheet.UsedRange.Rows.Count
Sht1ColCount = ActiveSheet.UsedRange.Columns.Count
Range(Cells(5, 1), Cells(5, Sht1ColCount)).Select
Range(Cells(5, 1), Cells(5, Sht1ColCount)).Copy
'Initiate Sheet2
'Copy header row from Monitor to initiate
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(1, Sht1ColCount)).Select
ActiveSheet.Paste
CopyDataMacro
End Sub
Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=True
End Sub
Sub CopyDataMacro()
'Select data rows from Monitor sheet
Sheets("Monitor").Select
Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Select
Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Copy
'Determine input in Sheet2 sheet
Sheets("Sheet2").Select
Dim LastRow, LastColumn As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
'Paste in Sheet2 Sheet
Range(Cells(LastRow + 1, 1), Cells(LastRow + Sht1RowCount - 1,
Sht1ColCount)).Select
Selection.PasteSpecial Paste:=xlValues
Cells(LastRow + 1, 1) = Time
'Save data
If ActiveWorkbook.Saved = False Then
ActiveWorkbook.Save
End If
' Call StartTimer to schedule the procedure
StartTimer
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=False
End Sub