AW: Tabellenblatt kopieren wenn voll
14.11.2010 14:51:31
Josef
Hallo Jens,
das sollte klappen. (der Teil mit Application.Match(...) hat bei mir nicht funktioniert, hab das etwas umgebaut!)
Sub Uebertragen()
Dim rng As Range, rngF As Range
Dim lngRow As Long
On Error GoTo ErrExit
Application.ScreenUpdating = False
With Sheets("Tabelle1")
If .Range("J11").Text <> "Leerdatensatz" Then
Set rngF = .Range("J11:CR30").Find(What:="Leerdatensatz", LookAt:=xlPart, LookIn:=xlValues)
If Not rngF Is Nothing Then
Set rng = .Range("J11:CS" & rngF.Row + 2)
Else
Set rng = .Range("J11:CS30")
End If
End If
End With
If Not rng Is Nothing Then
With Sheets("Daten")
lngRow = Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
If lngRow + rng.Rows.Count > .Rows.Count Then
.Copy After:=Sheets(Sheets.Count)
.Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)).ClearContents
lngRow = 2
End If
.Cells(lngRow, 1).Resize(rng.Rows.Count, rng.Columns.Count) = rng.Value
End With
End If
ErrExit:
Application.ScreenUpdating = True
Set rngF = Nothing
Set rng = Nothing
End Sub
Gruß Sepp