Hi all :hi
Unlike other boards I like to see that we also include error-handling in the provided solutions, especially when they are supposed to be used by less skilled user.
Therefore I made the following add-ons:
Option Explicit
Sub Do_It()
Dim rnSource As Range, rnStart As Range, rnTarget as Range
If ActiveSheet.ProtectContents = False Then
If TypeName(Selection) = "Range" Then
With Selection
If .Columns.Count <> 1 Then
MsgBox "Please make sure that the selection only contains one column.", vbInformation
GoTo ExitHere
ElseIf .Areas.Count <> 1 Then
MsgBox "Please make sure that the selection only covers one area.", vbInformation
GoTo ExitHere
Else
Set rnSource = Selection
End If
End With
Else
MsgBox "You need to select a range before executing this procedure.", vbExclamation
GoTo ExitHere
End If
Else
MsgBox "You need to unprotect the worksheet before executing this procedure.", vbExclamation
GoTo ExitHere
End If
On Error Resume Next
Set rnStart = Application.InputBox( _
Prompt:="Please select the first cell in the target range:", _
Title:="Select targetrange", _
Type:=8)
On Error GoTo 0
If rnStart Is Nothing Then
GoTo ExitHere
Else
Set rnTarget = rnStart.Resize(rnSource.Rows.Count, 1)
Transfer rnSource, rnTarget
End If
ExitHere:
Exit Sub
End Sub
Private Sub Transfer(ByRef rng As Range, ByRef Target As Range)
Application.ScreenUpdating = False
rng.Copy
Target.PasteSpecial (xlPasteAll)
With rng
.Hyperlinks.Delete
End With
With Application
.CutCopyMode = False
.ScreenUpdating = True
End With
End Sub
Kind regards,
Dennis