VBA to copy data from area and insert this data to an Excel Table

Hi Experts

I have a spreadsheet, where I copy some of the data from a pivottable to another sheet, and paste the information below existing data.

This is done by VBA, and repeats itself based on a timer.

It Works and can be used, but I would prefer to paste the data to a Table called Tbl_Summarized, as i have a lot of other calculations that can use the advantages of the functionality in tables.

How can I change the code below, so it will always append my copied area to the existing table (insert rows below existing rows of data in my table)?

Option Explicit

'Dim as a Public variable and it will be available to all Procedures in all modules.
Public rTime As Date
Dim rwInMax As Long
Dim rwIn As Long


Sub CellValueAutoIncr1()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.

rTime = Now + TimeValue("00:00:15")
 
Application.ScreenUpdating = False
 
'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
Cells(1, 1).Value = Cells(1, 1).Value + 1

Worksheets("Dataload").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Worksheets("Pivot").Select
Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
rwInMax = rwInMax

Worksheets("Pivot").Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
Worksheets("Dagens summerede Data").Select
Worksheets("Dagens summerede Data").Range("A" & rwInMax).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
    
For rwIn = 3 To rwInMax - 1 'rwInMax      'repeat until you reach the bottom of the sourcesheet or actually the datarange set

        If IsEmpty(Worksheets("Dagens summerede Data").Range("H" & (rwIn))) Then

            If Not IsEmpty(Worksheets("Dagens summerede Data").Range("A" & (rwIn))) Then

                Worksheets("Dagens summerede Data").Range("H" & (rwIn)) = Format(Now, "hh:mm:ss")

            Else

            End If

        Else

        End If

    Next rwIn

Worksheets("Test").Select

Application.ScreenUpdating = True


If Cells(1, 1).Value > 1 Then

Application.OnTime rTime, "CellValueAutoIncr1", , False

End If

End Sub

Open in new window

LVL 4
JorgenConsultantAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
Hi,

If you paste your data at the end of table, the table will normally expand to include these new rows

Regards
0
scsymeCommented:
Try this. Note that I have assumed that the table in question is also on the "Dagens summerede Data". You will need to amend this if it is not the case.

Option Explicit

'Dim as a Public variable and it will be available to all Procedures in all modules.
Public rTime As Date

Sub CellValueAutoIncr1()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.

rTime = Now + TimeValue("00:00:15")
 
Application.ScreenUpdating = False
 
'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
Worksheets("Test").Select
Cells(1, 1).Value = Cells(1, 1).Value + 1

Worksheets("Dataload").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Worksheets("Pivot").Select
Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

Worksheets("Pivot").Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

' ##### Select the sheet containing the table Tbl_Summarized #####
 Sheets("Dagens summerede Data").Select
    Range("Tbl_Summarized[#Headers]").Select
    Selection.End(xlToRight).Select
    Dim newRow As ListRow
    Set newRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=False)
    newRow.Range.Select
    ActiveSheet.Paste
    
Worksheets("Test").Select

Application.ScreenUpdating = True

If Cells(1, 1).Value > 1 Then

Application.OnTime rTime, "CellValueAutoIncr1", , False

End If

End Sub

Open in new window

0
Roy CoxGroup Finance ManagerCommented:
Is this where the Table is?

Worksheets("Dagens summerede Data"?

What is the Loop for? Is it formatting as Time?

This code is untested so try it on a backup workbook

'Dim as a Public variable and it will be available to all Procedures in all modules.
Public rTime As Date
Dim rwInMax As Long
Dim rwIn As Long


Sub CellValueAutoIncr1()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.
    Dim oTbl As ListObject
    Dim oRw As ListRow

    rTime = Now + TimeValue("00:00:15")

    Application.ScreenUpdating = False

    'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
    Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

    'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
    Cells(1, 1).Value = Cells(1, 1).Value + 1

    Worksheets("Dataload").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Worksheets("Pivot").Select
    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

    rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
    rwInMax = rwInMax

    With Worksheets("Dagens summerede Data")
        Set oTbl = .ListObjects("Tbl_Summarized")
        Worksheets("Pivot").Range("A6").CurrentRegion.Copy

        Set oRw = oTbl.ListRows.Add(AlwaysInsert:=True)
        Range.Cells(1, 1).PasteSpecial xlValues

        rwInMax = oTbl.ListRows.Count
        'not sure what you are doing here
        For rwIn = 3 To rwInMax - 1    'rwInMa otbl.x      'repeat until you reach the bottom of the sourcesheet or actually the datarange set

            If IsEmpty(.Range("H" & (rwIn))) Then

                If Not IsEmpty(.Range("A" & (rwIn))) Then

                    .Range("H" & (rwIn)) = Format(Now, "hh:mm:ss")

                Else

                End If

            Else

            End If

        Next rwIn
    End With
    Worksheets("Test").Select

    Application.ScreenUpdating = True


    If Cells(1, 1).Value > 1 Then

        Application.OnTime rTime, "CellValueAutoIncr1", , False

    End If

End Sub

Open in new window

0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Rgonzo1971Commented:
Hi,

pls try

 Range("Tbl_Summarized").End(xlDown).Offset(1).Select
 ActiveSheet.Paste

Regards
0
JorgenConsultantAuthor Commented:
Hi Guys

I have tried to insert data below, but for some reason, it seems like just pasting without expanding the table.

Yes the Worksheets("Dagens summerede Data"? is where data goes.

 The loop secures, that we have a timestamp on all new records. We need a summarised view every 10 minutes to decide speed. ( I know, that in the code it says 15 seconds at the moment)

I prefer the table solution, if it Works, but I sure will test both versions

regards

Jørgen
0
Rgonzo1971Commented:
Could you send a dummy?
0
Roy CoxGroup Finance ManagerCommented:
Have you tried the amended code it should add the data to the bottom of the data table.  A dummy workbook would help for testing the code.
0
JorgenConsultantAuthor Commented:
@ Roy,

I get the following compile error on the bold code - any suggestions

Set oRw = oTbl.ListRows.Add(AlwaysInsert:=True)
       Range.Cells(1, 1).PasteSpecial xlValues



Compile Error:
Argument not optional

@ Rgonzo

I will test your suggestion first - and if it does not Work, I will see if I can send a dummy, but it is a Little complex to extract the correct data

regards

Jørgen
0
JorgenConsultantAuthor Commented:
@Rgonzo

I get the following error:
Application defined or object defined error

any suggestions
0
Roy CoxGroup Finance ManagerCommented:
Sorry, try this

orw.Range.Cells(1, 1).PasteSpecial xlValues

Open in new window

0
scsymeCommented:
Okay, I have put the timestamp code back in. Please confirm whether or not this works for you.

Option Explicit

'Dim as a Public variable and it will be available to all Procedures in all modules.
Public rTime As Date

Sub CellValueAutoIncr1()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.

rTime = Now + TimeValue("00:00:15")
 
Application.ScreenUpdating = False
 
'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
Worksheets("Test").Select
Cells(1, 1).Value = Cells(1, 1).Value + 1

Worksheets("Dataload").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Worksheets("Pivot").Select
Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

Worksheets("Pivot").Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

' ##### Select the sheet containing the table Tbl_Summarized #####
 Sheets("Dagens summerede Data").Select
    Range("Tbl_Summarized[#Headers]").Select
    Dim newRow As ListRow
    ' The next line works with AlwaysInsert:=False. Changing this to True breaks cancels the copy therefore breaking the paste
    Set newRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=False)
    newRow.Range(1, 1).Select
    ActiveSheet.Paste
    ' Assuming timestamp goes in the eighth column of the table
    newRow.Range.Cells(1, 8).Select
    ' ***** The next line will cause trouble if only a single row was pasted
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = Format(Now, "hh:mm:ss")
    
Worksheets("Test").Select

Application.ScreenUpdating = True

If Cells(1, 1).Value > 1 Then

Application.OnTime rTime, "CellValueAutoIncr1", , False

End If

End Sub

Open in new window

0
Roy CoxGroup Finance ManagerCommented:
Why use Selection?

To add the Time Stamp using my oTbl variable

 oTbl.ListColumns(8).SpecialCells(xlCellTypeBlanks).Value = Format(Time, "hh:mm:ss")

Open in new window

0
JorgenConsultantAuthor Commented:
@ scsyme

The code stops at ActiveSheet.Paste

@ Roy

No difference if I changed the code.

regards

Jørgen
0
JorgenConsultantAuthor Commented:
Hi Roy,

The Timestamp is my smallest problem. If the general paste Works, I am fully satisfied.

regards

Jørgen
0
Roy CoxGroup Finance ManagerCommented:
Jorgen

An example workbook would really help.

I use similar code to this regularly. Try this and note any error messages

Sub CellValueAutoIncr1()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.
    Dim oTbl As ListObject
    Dim oRw As ListRow

    rTime = Now + TimeValue("00:00:15")

    Application.ScreenUpdating = False

    'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
    Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

    'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
    Cells(1, 1).Value = Cells(1, 1).Value + 1

    Worksheets("Dataload").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Worksheets("Pivot").Select
    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

    rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
    rwInMax = rwInMax

    With Worksheets("Dagens summerede Data")
        Set oTbl = .ListObjects("Tbl_Summarized")
        Worksheets("Pivot").Range("A6").CurrentRegion.Copy

        Set oRw = oTbl.ListRows.Add(AlwaysInsert:=True)
        oRw.Range.Cells(1, 1).Resize(, 7).PasteSpecial xlValues
        oTbl.ListColumns(8).SpecialCells(xlCellTypeBlanks).Value = Format(Time, "hh:mm:ss")
    End With
    Worksheets("Test").Select

    Application.ScreenUpdating = True

    If Cells(1, 1).Value > 1 Then
        Application.OnTime rTime, "CellValueAutoIncr1", , False
    End If

End Sub

Open in new window

0
JorgenConsultantAuthor Commented:
Hi Roy,

I will send an example file.

I just need to disconnect from server.

regards

Jørgen
0
Roy CoxGroup Finance ManagerCommented:
Thanks
0
JorgenConsultantAuthor Commented:
Hi all,

I have put your code in the (3) macro, while my original code is in the (1) macro

If you have questions, please get back to me

regards

Jørgen
EE-Produktion-Dashboard.xlsm
0
Roy CoxGroup Finance ManagerCommented:
The copy seems to work fine now. Will you always be copying to a blank table? If not the code will need a slight adjustment

Sub CellValueAutoIncr1a()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.
    Dim oTbl As ListObject
    Dim oRw As ListRow
    Dim Rws As Integer

    rTime = Now + TimeValue("00:00:15")

    Application.ScreenUpdating = False

    'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
    Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

    'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
    '    Cells(1, 1).Value = Cells(1, 1).Value + 1

    '    Worksheets("Dataload").Select
    '    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    '    Worksheets("Pivot").Select
    '    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh
    '
    '    rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
    '    rwInMax = rwInMax

    With Worksheets("Dagens summerede Data")
        Set oTbl = .ListObjects(1)

       With Worksheets("Pivot")
       Rws = .Range(.Cells(6, 1), .Cells(6, 7).End(xlDown).Offset(-1)).Rows.Count
        .Range(.Cells(6, 1), .Cells(6, 7).End(xlDown).Offset(-1)).Copy oTbl.ListRows(1).Range.Resize(Rws, 7)
             
    End With
    Worksheets("Test").Select

    Application.ScreenUpdating = True

    If Cells(1, 1).Value > 1 Then
        Application.OnTime rTime, "CellValueAutoIncr1", , False
    End If

End Sub

Open in new window

0
Rory ArchibaldCommented:
Try this:

Sub CellValueAutoIncr3()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.
    Dim oTbl                  As ListObject
    Dim PT                    As PivotTable
    Dim wsTable               As Worksheet
    Dim rgPaste               As Range
    Dim rgCell                As Range
    Dim lCount                As Long

    rTime = Now + TimeValue("00:00:15")

    Application.ScreenUpdating = False

    Set wsTable = Worksheets("Dagens summerede Data")

    Set oTbl = wsTable.ListObjects("Tbl_Summarized")

    'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
    Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr3", schedule:=True

    'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
    With Sheets("Test")
        .Cells(1, 1).Value = .Cells(1, 1).Value + 1
    End With

    Set PT = Worksheets("Pivot").PivotTables(1)
    PT.PivotCache.Refresh

    If Len(oTbl.Range(2, 1).Value) <> 0 Then
        Set rgPaste = oTbl.Range.Offset(oTbl.Range.Rows.Count).Resize(1)
    Else
        Set rgPaste = oTbl.Range(2, 1)
    End If

    ' copy data below table
    With PT.RowFields(1).DataRange
        lCount = .Rows.Count
        .Resize(, PT.TableRange2.Columns.Count).Copy rgPaste
    End With

    oTbl.Resize oTbl.Range.Resize(oTbl.Range.Rows.Count + lCount)
    For Each rgCell In oTbl.ListColumns("Time").Range.Cells
        If Len(rgCell.Value) = 0 Then
            rgCell.Value = Now
            rgCell.NumberFormat = "hh:mm:ss"
        End If
    Next rgCell

    Application.ScreenUpdating = True

    If Sheets("Test").Cells(1, 1).Value > 1 Then Application.OnTime rTime, "CellValueAutoIncr3", , False

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
JorgenConsultantAuthor Commented:
Hi Roy,

No I will not be copying to an empty tabel. I will do that every morning, but after that, I will get new data every 10 minutes, that should be added below existing data.

regards

Jørgen
0
Roy CoxGroup Finance ManagerCommented:
Sorry slight amendment to code

Sub CellValueAutoIncr1a()
'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.

'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.

'set the time interval at 15 seconds, at which interval the procedure will run.
    Dim oTbl As ListObject
    Dim oRw As ListRow
    Dim Rws As Integer

    rTime = Now + TimeValue("00:00:15")

    Application.ScreenUpdating = False

    'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
    Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

    'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
    '    Cells(1, 1).Value = Cells(1, 1).Value + 1

    '    Worksheets("Dataload").Select
    '    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    '    Worksheets("Pivot").Select
    '    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh
    '
    '    rwInMax = Worksheets("Dagens summerede Data").Range("A1").CurrentRegion.Rows.Count
    '    rwInMax = rwInMax

    With Worksheets("Dagens summerede Data")
        Set oTbl = .ListObjects(1)
    End With
    With Worksheets("Pivot")
        Rws = .Range(.Cells(6, 1), .Cells(6, 7).End(xlDown).Offset(-1)).Rows.Count
        .Range(.Cells(6, 1), .Cells(6, 7).End(xlDown).Offset(-1)).Copy oTbl.ListRows(1).Range.Resize(Rws, 7)

    End With


    Worksheets("Test").Select

    Application.ScreenUpdating = True

    If Cells(1, 1).Value > 1 Then
        Application.OnTime rTime, "CellValueAutoIncr1", , False
    End If

End Sub

Open in new window

0
JorgenConsultantAuthor Commented:
Hi Roy and Rory,

It seems like both codes Work, but for some reason Roy's code does not seem to Work, which I will look into.

If I have questions regarding the code I will get back to you.

regards

Jørgen
0
Roy CoxGroup Finance ManagerCommented:
Hi Jorgen

The code works on the example .  I was having problems with first part of the code

Worksheets("Dataload").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Worksheets("Pivot").Select
    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

Open in new window


When I blanked this code the actual data copy worked
0
scsymeCommented:
Hi,

I have resolved the pasting issue by only copying just before requiring the paste. Full code below.

Option Explicit

'Dim as a Public variable and it will be available to all Procedures in all modules.
Public rTime As Date

Sub CellValueAutoIncr1()

    Dim newRow As ListRow

'This procedure uses the OnTime Method to auto increment cell value at specific time intervals, and Stops the procedure on crossing a specific cell value.
'To run a procedure at a specific time, use TimeValue(time) viz. TimeValue("20:30:00") will run a procedure at 8.30 pm. To run a procedure at specified time intervals (say, from now), use Now + TimeValue(time) viz. Now + TimeValue("00:00:15") sets the time interval at 15 seconds, at which interval the procedure will run.
'set the time interval at 15 seconds, at which interval the procedure will run.
rTime = Now + TimeValue("00:00:15")
Application.ScreenUpdating = False
 
'procedure named CellValueAutoIncr1 will autmatically run, at the sheduled time interval, with the OnTime Method.
Application.OnTime EarliestTime:=rTime, Procedure:="CellValueAutoIncr1", schedule:=True

'increment the value in cell A1 (in Active Worksheet) by 1, for each time the Macro is repeated:
Worksheets("Test").Select
    Cells(1, 1).Value = Cells(1, 1).Value + 1

Worksheets("Dataload").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

Worksheets("Pivot").Select
    Worksheets("Pivot").PivotTables("Pivottabel1").PivotCache.Refresh

' ##### Select the sheet containing the table Tbl_Summarized #####
Worksheets("Dagens summerede Data").Select
    Range("Tbl_Summarized[#Headers]").Select
    Set newRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
    newRow.Range(1, 1).Select
    
Worksheets("Pivot").Select
Worksheets("Pivot").Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
Worksheets("Dagens summerede Data").Select
    ActiveSheet.Paste
    ' Assuming timestamp goes in the eighth column of the table
    newRow.Range.Cells(1, 8).Select
    ' ***** The next line will cause trouble if only a single row was pasted
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormulaR1C1 = Format(Now, "hh:mm:ss")
    
Worksheets("Test").Select

Application.ScreenUpdating = True

If Cells(1, 1).Value > 1 Then

Application.OnTime rTime, "CellValueAutoIncr1", , False

End If

End Sub

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.