Option
Explicit
Sub
TastIt()
Dim
rngCopyFrom
As
Range
Dim
rngCopyTo
As
Range
Dim
rngCopyCells
As
Range
Dim
rngStep
As
Range
Dim
myOffRow
As
Long
On
Error
GoTo
TastIt_Error
ActiveSheet.Unprotect
Set
rngCopyFrom = Application.InputBox(
"Doppelklick in Spaltenkopf"
,
"Quellspalte selektieren"
, , , , , , 8)
If
rngCopyFrom.Cells.Count < Rows.Count
Then
Err.Raise 513
Set
rngCopyTo = Application.InputBox(
"Doppelklick in Spaltenkopf"
,
"Zielspalte selektieren"
, , , , , , 8)
If
rngCopyTo.Cells.Count < Rows.Count
Then
Err.Raise 513
Set
rngCopyCells = Range(rngCopyFrom.Cells(1), Cells(Rows.Count, rngCopyFrom.Column).
End
(xlUp))
For
Each
rngStep
In
rngCopyCells.Cells
If
Cells(rngStep.Row, rngCopyTo.Column).Offset(myOffRow).Locked =
True
Then
myOffRow = myOffRow + 1
Do
While
Cells(rngStep.Row, rngCopyTo.Column).Offset(myOffRow).Locked =
True
myOffRow = myOffRow + 1
Loop
End
If
rngStep.Copy Destination:=Cells(rngStep.Row, rngCopyTo.Column).Offset(myOffRow)
Next
rngStep
On
Error
GoTo
0
TastIt_Error:
Select
Case
Err.Number
Case
Is
= 0:
Case
Is
= 513
Call
MsgBox(
"keine ganze Spalte selektiert!"
, vbCritical,
"Abbruch"
)
Case
Else
:
End
Select
ActiveSheet.Protect
End
Sub