Makro korrigieren
28.12.2006 13:07:57
Michael
könnte sich bitte jemand Mal mein Makro anschauen. Wenn in der Tabelle "A-Liste" nicht alle Anfangszellen ( A11:B38 ) befüllt werden, kommt die Fehlermeldung "Index außerhalb des gültigen Bereichs". Wie stell ich das ab. Der Anwender soll natürlich die Möglichkeit haben, je nach Bedarf so viele Zeilen zu befüllen wie er möchte.
Hier mein Makro:
Sub DatenUebernehmen()
Dim objSh As Worksheet
Dim lngFirst As Long
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B12"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a11:n11").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B14"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a13:n13").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B16"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a15:n15").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B18"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a17:n17").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B20"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a19:n19").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B22"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a21:n21").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B24"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a23:n23").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B26"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a25:n25").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B28"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a27:n27").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B30"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a29:n29").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B32"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a31:n31").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B34"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a33:n33").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B36"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a35:n35").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("B38"), "mmmm"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 0, 14)) = Sheets("A-Liste").Range("a37:n37").Value
End With
On Error GoTo ErrExit
Set objSh = Sheets(Format(Sheets("A-Liste").Range("b3"), "Provisionskontrolle"))
With objSh
lngFirst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If .Cells(Rows.Count, 2).End(xlUp).Row + 1 > lngFirst Then lngFirst = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Range(.Cells(lngFirst, 1), .Cells(lngFirst + 25, 14)) = Sheets("A-Liste").Range("A11:n38").Value
End With
'Datenbereich löschen!
Sheets("A-Liste").Range("A11:r38").ClearContents
Set objSh = Nothing
Exit Sub
ErrExit:
If Err.Number > 0 Then
MsgBox Err.Number & vbLf & Err.Description, 48, "Fehler"
End If
End Sub
Grüße
Michael
Anzeige