Simpler Macro required

[Thomo4321]

Afternoon All,

I have the following Macro for the sample Table below.

I would like the Macro to loop until it reaches the end of the table, at the moment i have the shortcut entered at the end but this requires me to be infront of the computer at all times to end the macro by pressing ESC.

Any help is much appreciated

[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]PART[/TD]
[TD]MAKE[/TD]
[TD]MIN[/TD]
[TD]MAX[/TD]
[TD]2M[/TD]
[TD]1M[/TD]
[TD]REORDER[/TD]
[/TR]
[TR]
[TD]ABCD[/TD]
[TD]SE[/TD]
[TD]1[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Selection.Copy
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "%{Tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "^v"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "{tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "%{tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "{Right}{Right}{Right}{Right}"
Application.Wait (Now() + TimeValue("00:00:01"))
Selection.Copy
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "%tab"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "{tab}{tab}{tab}{tab}{tab}{tab}{tab}{tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "^v"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "{Tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "%{tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "{right}"
Application.Wait (Now() + TimeValue("00:00:01"))
Selection.Copy
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "%{Tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "^v"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "{Tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "%{Tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "{right}"
Application.Wait (Now() + TimeValue("00:00:01"))
Selection.Copy
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "%{Tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "^v"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "%{Tab}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "{down}{left}{left}{left}{left}{left}{left}"
Application.Wait (Now() + TimeValue("00:00:01"))
Application.SendKeys "^m"










End Sub

 

[BlueAure]

Can you just select the cell you want? Or do you have to tab to it?

You could do something like:

    dim lRow as integer, dim lCol as integer
    'Find the last non-blank cell in column A(1)
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    'Find the last non-blank cell in row 1
    lCol = Cells(1, Columns.Count).End(xlToLeft).Column

    'Select the rightmost column and bottommost row
    cells(lRow, lCol).select

 

[Thomo4321]

Thanks BlueAure,

With every second %{Tab} It can be anything, but after the first %{Tab} i need to keep it as is as my program that im trying to enter info in doesnt like anything else, also some times it lags hence all the wait times in my original macro.

The table i suppied is only a snippet, my spreadsheet has about 84 columns. but the snippet is all the info i require for this macro.

Thanks