Sub SpalteKopieren()
Worksheets("Rasterblatt").Unprotect Password:="test"
'die Umgebung festlegen ! ********************************************
Const QUELLTABELLE As String = "Rasterblatt"
Const ZIELTABELLE As String = "Daten"
Const QUELLSPALTE As String = "B"
'*********************************************************************
'
Dim rngQuelle As Range, c As Range
Dim lngZielspalte As Long
With Sheets(ZIELTABELLE)
lngZielspalte = 2
'Belegung prüfen
Set c = .UsedRange
If c.Address <> .Cells(2).Address Then
'schon benutzt
lngZielspalte = c.Columns(c.Columns.Count).Offset(, 1).Column
End If
End With
Set c = Nothing
With Sheets(QUELLTABELLE).Columns(QUELLSPALTE)
'Belegung prüfen
On Error Resume Next
Set c = .ColumnDifferences(Comparison:=.Cells(.Rows.Count))
On Error GoTo 0
If Not c Is Nothing Then
'Daten gefunden
'Ziel = lngZielspalte Zelle 1
c.Copy Destination:=Sheets(ZIELTABELLE).Columns(lngZielspalte).Cells(1)
End If
End With
Worksheets("Rasterblatt").Protect Password:="test"
End Sub
|