View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Priyanka[_2_] Priyanka[_2_] is offline
external usenet poster
 
Posts: 5
Default Code seems to have not copied fully

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, Procedu=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, Procedu=cRunWhat,
Schedule:=False
End Sub