Pasting data from clipboard between workbooks 1

[mrfitness]

thread707-1380005

I used the code in the above thread and it gives me a message box showing the data stored in memory. However, I want to paste the data and I am having problems.
I tried using ActiveCell.Value = MyData.GetText(1) as well as ActiveCell.Value = Selection but I am getting all the data into one cell with ctrl breaks instead of pasting the data in multiple cells

Please help!

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Sub Clear_Clipboard()
   OpenClipboard (0)
   EmptyClipboard
   CloseClipboard
End Sub

Sub myFunc()
   Set MyData = New DataObject
   MyData.GetFromClipboard
   
   On Error GoTo ERRHANDLER
   
   strClip = MyData.GetText(1)
   MyData.SetText strClip
   MyData.PutInClipboard
   
   MsgBox MyData.GetText
   
'Cpy.GetFromClipboard

    Selection = MyData.GetText(1)

'this is where I want to paste the data, but not getting the result
   ActiveCell.Value = Selection
   

    Application.CutCopyMode = False
   
   Exit Sub
ERRHANDLER:
   MsgBox "Empty Clipboard"
End Sub

 

[SkipVought]

Sub CopyFunc()
    Activecell.PasteSpecial [b]xlPasteValues[/b]
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[mrfitness]

Ok, tried that.
I set

application..OnKey "^v", "CopyFunc"

then i used your code

Public Sub CopyFunc()
    ActiveCell.PasteSpecial xlPasteValues
End Sub

I put a toggle break to make sure this was being used upon Ctrl+v (I disabled right click on the cell as well as the menu function to force users to only copy using ctrl+v)

Even though it worked as it should via code, it still did not paste values. It copied as it normally would via a Ctrl+v, with format and such as well.

As explained before, I run code on workbook activate and deactive which hides toolbars and disables all shortcuts upon activate and restores them on deactivate. Maybe that has something to do with the code not working?

 

[SkipVought]

Yes, when you do that programitic event driven code, it clears the Excel Copy Clipboard, not the Windows Clipboard which has NO EXCEL FEATURES.

Try using Split to parse the Selection contents into an array.

Then loop thru the array assigning values to the cells relative to the activecell.

Sub myFunc()
    Dim MyData As Object, strClip As String
    Dim a1, a2, sel, i As Integer, j As Integer
    
    Set MyData = New DataObject
    MyData.GetFromClipboard
    
    On Error GoTo ERRHANDLER
    
    strClip = MyData.GetText(1)
    MyData.SetText strClip
    MyData.PutInClipboard
    
    '   MsgBox MyData.GetText
    
    'Cpy.GetFromClipboard
    
     sel = MyData.GetText(1)
     a1 = Split(sel, vbCrLf)
     For i = 0 To UBound(a1)
        a2 = Split(a1(i), vbTab)
        For j = 0 To UBound(a2)
            ActiveCell.Offset(i, j) = a2(j)
        Next
     Next
        
    
     Application.CutCopyMode = False
    
    Exit Sub
ERRHANDLER:
    MsgBox "Empty Clipboard"
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[mrfitness]

OK I figured it out! Thank you everyone for your support and ideas!

Note the reason why this works in my case is because a simple pastespecial values in code did not work as my workbook activate and deactive code disables and enables shortcuts, toolbars, etc. I also deactivated the right click for users, and since I removed all toolbars, the user cannot click 'Edit' and 'Paste'.

First, in the workbook activate & workbook open code I put

Application.OnKey "^v", "myFunc"

This calls the code below (mYFunc) when a user presses Ctrl+v:

Next, enter all this code into a module (I split it out so it is easier to read):

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Public Function ColumnLetter(ColumnNumber As Long) As String
'this gets the column letter based on the column number selected

  If ColumnNumber > 26 Then
 
    ' 1st character:  Subtract 1 to map the characters to 0-25,
    '                 but you don’t have to remap back to 1-26
    '                 after the 'Int’ operation since columns
    '                 1-26 have no prefix letter
 
    ' 2nd character:  Subtract 1 to map the characters to 0-25,
    '                 but then must remap back to 1-26 after
    '                 the 'Mod’ operation by adding 1 back in
    '                 (included in the '65?)
 
    ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
                   Chr(((ColumnNumber - 1) Mod 26) + 65)
  Else
    ' Columns A-Z
    ColumnLetter = Chr(ColumnNumber + 64)
  End If
End Function

Sub Clear_Clipboard()
   OpenClipboard (0)
   EmptyClipboard
   CloseClipboard
End Sub

Sub myFunc()

Dim startrow As Long, startcol As Long
    
Set MyData = New DataObject
MyData.GetFromClipboard

' On Error GoTo ERRHANDLER

strClip = MyData.GetText(1)
MyData.SetText strClip
MyData.PutInClipboard

Selection = MyData.GetText(1)

'get start row and column of where user is pasting
startrow = ActiveCell.Row
startcol = ActiveCell.Column

'call module to paste and format
Call pasteandformat(startrow, startcol)

Application.CutCopyMode = False

Exit Sub
'ERRHANDLER:
'   MsgBox "Empty Clipboard"
End Sub

Sub pasteandformat(startrow As Long, startcol As Long)
ActiveSheet.Unprotect "1:)NPbm"
Application.DisplayAlerts = False

    Dim x, txt As String, i As Long, cel As Range
    xx = Cells(Rows.Count, 1).End(xlUp).Row
    'paste data from one cell into seperate rows first
    For Each cel In Cells(startrow, startcol)
        txt = cel.Value
        If Right(txt, 1) = Chr$(10) Then txt = Left(txt, Len(txt) - 1)
        x = Split(txt, Chr(10))
        For i = 0 To UBound(x)
            Cells(startrow + i + 1, startcol).Value = x(i)
        Next
    Next cel
    
    'do text to columns to split the data into columns
    startletter = ColumnLetter(startcol)
    Range(startletter & startrow + 1 & ":" & startletter & startrow + i).Select
    Selection.TextToColumns Destination:=Range(startletter & startrow + 1), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=True, Semicolon _
        :=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array( _
        Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
 
 'we then have to select and copy the new range after text to column
 'and paste it in the row above where the data was pasted by the user
 
 Dim rflag As Boolean
 rflag = False
 
 'we need to find the last column of data
 'since there are at most 5 columns of data to copy in the application
 'we start looking at a column over offset from the paste, so the loop goes to 4
 For findrow = 1 To 4
 
    If rflag = False Then
    
       Range(startletter & startrow + 1).Offset(0, findrow).Select
     
         If ActiveCell = "" Then
           rflag = True
           endletter = ColumnLetter(startcol + findrow - 1)
           
         Else
           rflag = False
           
         End If
         
    End If
    
 Next

'select the range of text to columns
Range(startletter & startrow + 1 & ":" & endletter & (startrow + i)).Select
 Selection.Copy
 
'select the range that was originaly pasted by the user
 Range(startletter & startrow).Select
 'paste
 ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
     IconFileName:=False
 
'delete the last row because we have pasted 1 row up
Range(startletter & startrow + i & ":" & endletter & (startrow + i)).Select
Selection.ClearContents
 
End Sub

 

[SkipVought]

Check out my solution.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[mrfitness]

SkipVought your way is totally better! Thanks!

 

[SkipVought]

also please notice that I CHANGED your Selection to sel, as Selection is a reserved word OBJECT that has a specific meaning, that was not consistent with your procedure.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[mrfitness]

Beautiful, thank you again! I really appreciate the time you took to help

 

[Gavona]

mrfitness, welcome to the forum! From your post I would have thought you would want to:
[red]*[/red] Thank SkipVought
for this valuable post!

Gavin

 

[mrfitness]

Just noticed that! I like the fact that you do stuff like that on this site, very cool! Thanks again SkipVought and Gavona for the heads up!

 

[SkipVought]

Thanks mrfitness.

Let me add, for the benefit of Tek-Tip browsers, that in order for DataObject to work, you must have a reference set in Tools > References for the Microsoft Forms 2.0 Object Library

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}