Private Sub btnEins_Click()
Kopiere 1
End Sub
Private Sub btnZwei_Click()
Kopiere 2
End Sub
Private Sub Kopiere(vZahl As Long)
Dim lngZeile As Long, lngZielZeile As Long
Dim lngSpalte As Long, lngZielSpalte As Long
Dim oWS As Worksheet
Dim oRange As Range
lngZeile = 1
Do Until Cells(lngZeile, 1) = "Überschrift 1"
lngZeile = lngZeile + 1
Loop
lngZeile = lngZeile + 1
Set oWS = ActiveWorkbook.Worksheets.Add(, Worksheets(Worksheets.Count))
lngZielZeile = 2
Do Until Cells(lngZeile, 1) = ""
lngSpalte = 1
lngZielSpalte = 1
Do Until Cells(lngZeile, lngSpalte) = ""
oWS.Cells(lngZielZeile, lngZielSpalte) = Cells(lngZeile, lngSpalte)
lngSpalte = lngSpalte + 1
lngZielSpalte = lngZielSpalte + 1
Loop
lngZeile = lngZeile + 1
lngZielZeile = lngZielZeile + 1
Loop
If vZahl = 1 Then
Do Until Cells(lngZeile, 1) = "Überschrift 2"
lngZeile = lngZeile + 1
Loop
Else
Do Until Cells(lngZeile, 1) = "Überschrift 3"
lngZeile = lngZeile + 1
Loop
End If
lngZeile = lngZeile + 1
Do Until Cells(lngZeile, 1) = ""
lngSpalte = 1
lngZielSpalte = 1
Do Until Cells(lngZeile, lngSpalte) = ""
oWS.Cells(lngZielZeile, lngZielSpalte) = Cells(lngZeile, lngSpalte)
lngSpalte = lngSpalte + 1
lngZielSpalte = lngZielSpalte + 1
Loop
lngZeile = lngZeile + 1
lngZielZeile = lngZielZeile + 1
Loop
oWS.Activate
End Sub