How to Copy Format without using Clipboard?

[Ceeyee]

I want to copy the Format of a large range to another cell location using VBA.

I don't want to use .Copy and .Pastespecial because it will interupt with my PC front end copy and paste operations.

I found some code from the internet which does what I want but it's extremely slow as it uses loops to run through each cell.


Is there any way to do it without using the clipboard and looping through each cell to = the format? I am using Excel 2010.

Thanks.

 

[AlphaFrog]

Try using Copy-Destination:

Example

Range("A1:A10").Copy Destination:=Range("C2")

 

[Ceeyee]

This .copy method clears the clipboard which is what we are trying to avoid.

Any one has more suggestions?

 

[wigi]

Is there any way to do it without using the clipboard and looping through each cell to = the format?

Not as far as I know, if you'd ask me.

Maybe working with Styles can have advantages?

 

[Jaafar Tribak]

I have been playing around with this and I seem to have managed to preserve the clipboard contents even after performing a Copy & Paste operation. Tested on in XL2007 Win 7 only.


Try placing these two functions in a Standard module :

Option Explicit

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

Private Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Long) As Long

Private Declare Function SetClipboardData Lib _
"user32.dll" _
(ByVal wFormat As Long, _
ByVal hMem As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Dest As Any, Src As Any, _
ByVal lSize As Long)

Private Declare Function lstrlenA Lib "kernel32" _
(ByVal lpString As Long) As Long

Private Declare Function GlobalAlloc Lib "kernel32" _
(ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long

Private Declare Function GlobalLock Lib "kernel32" _
(ByVal hMem As Long) As Long

Private Declare Function GlobalUnlock Lib "kernel32" _
(ByVal hMem As Long) As Long

Private Const GMEM_FIXED = &H0
Private Const XML_SPREADSHEET = 49365


Private Function PutDataInClipBoard(ByVal sData As String) As Boolean

    Dim Buffer() As Byte
    Dim hData As Long
    Dim lpData As Long
    
    If OpenClipboard(0&) Then
        'Convert data to ANSI byte array.
        Buffer = StrConv(sData & vbNullChar, vbFromUnicode)
        'Allocate memory for buffer.
        hData = GlobalAlloc(GMEM_FIXED, UBound(Buffer) + 1)
        If hData Then
            'Copy data to allocated memory.
            lpData = GlobalLock(hData)
            Call CopyMemory(ByVal lpData, Buffer(0), UBound(Buffer) + 1)
            Call GlobalUnlock(hData)
            'Put data into the clipboard
            If SetClipboardData(XML_SPREADSHEET, hData) <> 0 Then
                PutDataInClipBoard = True
            End If
        End If
        CloseClipboard
    End If

End Function


Private Function GetDataFromClipBoard() As String

    Dim Buffer() As Byte
    Dim lLen As Long
    Dim hData As Long
    Dim lpData As Long
    
    'Open the clipboard.
    If OpenClipboard(0&) <> 0 Then
        'Get handle to the XML_Spreadsheet ClpBrd data.
        hData = GetClipboardData(XML_SPREADSHEET)
        'Lock the memory handle.
        lpData = GlobalLock(hData)
        lLen = lstrlenA(ByVal lpData)
        If lLen Then
            'Copy clpBrd data to Buffer.
            ReDim Buffer(0 To (lLen - 1)) As Byte
            CopyMemory Buffer(0), ByVal lpData, lLen
            Call GlobalUnlock(hData)
            GetDataFromClipBoard = StrConv(Buffer, vbUnicode)
        End If
        CloseClipboard
    End If

End Function

Usage :

Run this TEST macro in the same standard module above:

'*********'
'  Usage  '
'*********'
Sub Test()

    Dim sClipBoardData As String
    
    sClipBoardData = GetDataFromClipBoard
    Range("A1:A10").Copy Destination:=Range("C2")
    PutDataInClipBoard sClipBoardData

End Sub

 

[Ceeyee]

Seems like a very creative way of doing this.
Thanks.

 

[Ceeyee]

Update ..

Failed in Excel 2010 Win7.

Range("A1:A10") contents remains in the clipboard and PutDataInClipBoard doesn't seem to be working.

 

[Jaafar Tribak]

Update ..

Failed in Excel 2010 Win7.

Range("A1:A10") contents remains in the clipboard and PutDataInClipBoard doesn't seem to be working.

works fine for me.

Try editing the TEST code as follows :

Sub Test()

    Dim sClipBoardData As String
    
    sClipBoardData = GetDataFromClipBoard
    Range("A1:A10").Copy Destination:=Range("C2")
    [B]Application.CutCopyMode = False[/B]
    PutDataInClipBoard sClipBoardData

End Sub

 

[Ceeyee]

Still not working.
In this version, the A1:A10 contents are removed from the clipboard but the things that I had in the clipboard before running Test() are gone.

 

[Jaafar Tribak]

Still not working.
In this version, the A1:A10 contents are removed from the clipboard but the things that I had in the clipboard before running Test() are gone.

I don't know why you are loosing the clipboard contents. The code works perfectly for me. Could it be because of your vesion of excel ie 2010 ? I don't know.

Are you using (Win 7) 64 bits or 32 bits ?