Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copied formula produces unexpected copied results | New Users to Excel | |||
Ron De Bruin Code modification needed when naming copied worksheet | Excel Programming | |||
Haven't fully tested my code - whats wrong with it???? | Excel Programming | |||
Worksheet_Selection Change code will not allow cell contents to be copied and pasted onto the sheet it's running on | Excel Programming | |||
Excel 2002 - VBA code to insert copied cells?? | Excel Programming |