CODEWITHSUNDEEP
vbaexcelexcel-2007excel-2013
Ryflex
Ryflex

Reputation: 5769

VBA Copy Destination but as values

I'm trying to transfer data from one document to a different document using "Copy Destination" as I want to avoid using the clipboard but I want it to stop taking the formatting with it...

Dim Sheet As Worksheet
Dim FoundLocationSheet As Boolean
Dim n As Long
Dim AllSheet As Worksheet
Set AllSheet = Sheets("Main")

'Transfer data
For n = 1 To AllSheet.Cells(Rows.Count, 1).End(xlUp).Row
    If AllSheet.Cells(n, 1) = "TiTle" Then
        With Sheets(AllSheet.Cells(n - 1, 1).Value)
            AllSheet.Cells(n, 1).CurrentRegion.Copy Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
        End With
    End If
Next n

The macro could potentially pull data from A20:L40 and put it into A15:L35...

I'd been trying lots of different things with AllSheet.Cells(n, 1).CurrentRegion.Copy Destination:=.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0) but can't work out how to make it work...

The size of the sheet means clearing formats takes way too long :/

Any ideas?

Upvotes: 0

Views: 4930

Answers (2)

Paul Kelly
Paul Kelly

Reputation: 985

You could copy the data to any array and then from array to the destination. The code to do this is short and surprisingly efficient. Note: The source must have more than one cell.

' Create dynamic array
Dim arr() As Variant
Dim rg As Range


Set rg = AllSheet.Cells(n, 1).CurrentRegion
' Read values to array
arr = rg.Value

' Write the values back sheet
.Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Value = arr

Upvotes: 0

chris neilsen
chris neilsen

Reputation: 53137

Since you want to avoid the clipboard and only copy Values, you can use assignment to the Value property instead of Range.Copy

Something like this

Sub Demo()
    Dim Sheet As Worksheet
    Dim FoundLocationSheet As Boolean
    Dim n As Long
    Dim rSource As Range
    Dim rDest As Range
    Dim AllSheet As Worksheet

    Set AllSheet = Sheets("Main")

    'Transfer data
    For n = 1 To AllSheet.Cells(Rows.Count, 1).End(xlUp).Row
        If AllSheet.Cells(n, 1) = "TiTle" Then
            With Worksheets(AllSheet.Cells(n - 1, 1).Value)
                ' Reference the range to be copied
                Set rSource = AllSheet.Cells(n, 1).CurrentRegion
                ' Reference the Top Left cell of the destination range
                ' and resize to match source range
                Set rDest = _
                  .Cells(.Rows.Count, 1).End(xlUp).Offset(2, 0) _
                  .Resize(rSource.Rows.Count, rSource.Columns.Count)
                ' Copy values
                rDest.Value = rSource.Value
            End With
        End If
    Next n
End Sub

Upvotes: 1

Related Questions