Diane
you could try this "kludgy" technique
good luck
Tim
PS if this code won't work, am happy to send you the file
that work!
Option Explicit
'Because these procedures use the DataObject variable
type,
'you must have a reference set in your VBA project to the
Microsoft Forms 2.0 object library.
Declare Function GetForegroundWindow Lib "user32.dll" ()
As Long
Sub foo()
Dim testing
Dim bFound As Boolean
Dim iCounter As Integer
Dim iTotalMacroNo As Integer
Dim MacroNames(12, 2)
If IsVBEActive Then Exit Sub
Range("A9").Select
'testing = GetOffClipboard
'MsgBox testing
Application.SendKeys ("%TMM{TAB 2}{UP 12}{TAB}") 'set for
all open workboooks
Application.SendKeys ("{ESC 2}") 'quit
iCounter = 1
Do While bFound = False
DoEvents
Application.SendKeys ("{DOWN}")
Application.SendKeys ("%TMM") 'start
Application.SendKeys ("{TAB}{DOWN " & iCounter - 1 & "}
{TAB 8}")
'
Application.SendKeys ("{F2}{END}")
Application.SendKeys ("+{HOME}")
Application.SendKeys ("^c")
Application.SendKeys ("{ESC}") 'quit
Application.SendKeys ("^v")
'Range("A20").Value = GetOffClipboard
'Range("A9").Offset(iCounter, 0).Select
'Application.SendKeys ("^v{DOWN}")
'Range("A9")(2, 1) = Range("A1").Value '"test" '.Offset
(iCounter, 1)
'Range("A9")(1 + iCounter, 1) = Range("A1") '.Select
'Application.SendKeys ("^v~")
'Cells(9 + iCounter, 2) = Range("a1")
If iCounter = 200 Then bFound = True
DoEvents
Application.SendKeys ("{DOWN}{UP}")
Debug.Print "iCounter = " & iCounter & " " &
Application.WorksheetFunction.CountIf(Range("A:A"),
ActiveCell.Value)
If Application.WorksheetFunction.CountIf(Range("A:A"),
ActiveCell.Value) > 1 Then
bFound = True
ActiveCell.ClearContents
iTotalMacroNo = iCounter
End If
iCounter = iCounter + 1
Loop
'Exit Sub '
Range("B9").Select
For iCounter = 1 To iTotalMacroNo
Application.CutCopyMode = False
ActiveCell.Copy
DoEvents
Application.SendKeys ("{DOWN}")
Application.SendKeys ("%TMM") 'start
Application.SendKeys ("{TAB}{DOWN " & iCounter - 1
& "}%o")
'
Application.SendKeys ("{F2}{END}")
Application.SendKeys ("+{HOME}")
Application.SendKeys ("^c")
Application.SendKeys ("{ESC 2}") 'quit
Application.SendKeys ("^v")
Next iCounter
'Application.SendKeys ("{ESC 2}")
'Range("A20").Value = GetOffClipboard
End Sub
Public Sub PutOnClipboard(Obj As Variant)
Dim MyDataObj As New DataObject
MyDataObj.SetText Format(Obj)
MyDataObj.PutInClipboard
End Sub
Public Function GetOffClipboard() As Variant
Dim MyDataObj As New DataObject
MyDataObj.GetFromClipboard
GetOffClipboard = MyDataObj.GetText()
End Function
Public Sub ClearClipboard()
Dim MyDataObj As New DataObject
MyDataObj.SetText ""
MyDataObj.PutInClipboard
End Sub
Function IsVBEActive() As Boolean
Dim hWndP1 As Long
Dim hWndP2 As Long
hWndP1 = Application.VBE.MainWindow.hwnd
'Find the active window
hWndP2 = GetForegroundWindow
IsVBEActive = (hWndP1 = hWndP2)
End Function