Hi,

nun ICH meine, du wirst wegen der vielen Sonderfälle nicht um Code herumkommen, der Zelle für Zelle prüft und kopiert.

In Etwa so:

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)
      '
      'Debug.Print rngStep.Address
   Next rngStep
'
   On Error GoTo 0
'
TastIt_Error:
'------------------------------------------------------------------------------
Select Case Err.Number
   Case Is = 0: 'errorless
   Case Is = 513
      Call MsgBox("keine ganze Spalte selektiert!", vbCritical, "Abbruch")
   Case Else:
End Select
'------------------------------------------------------------------------------
ActiveSheet.Protect
End Sub