Like this:
Option Explicit
Sub Copy_1_Value_PasteSpecial()
Dim SourceRange As Range, DestRange As Range
Dim DestSheet As Worksheet, Lr As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'fill in the Source Sheet and range
Set SourceRange = Sheets("Sheet1").Range("b2:b5")
'Fill in the destination sheet and call the LastRow
'function to find the last row
Set DestSheet = Sheets("Sheet1")
Lr = LastRow(DestSheet)
'With the information from the LastRow function we can
'create a destination cell
Set DestRange = DestSheet.Range("A" & Lr + 1)
'Copy the source range and use PasteSpecial to paste in
'the destination cell
SourceRange.Copy
DestRange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Clioff Edwards
|