Rangeobjekt kann nicht aktiviert werden
31.08.2005 16:28:56
Eleni
Hoffe jmd kann mir dabei helfen, den Fehler aus dem unten stehenden Code zu kriegen. Jedesmal wenn das makro durchläuft, bekomme ich bei der Zeile:
ActiveSheet.Range("A6", Cells(Rows.Count, 1).End(xlUp).Offset(0, 9)).Activate
den Fehler: 'Laufzeitfehler 1004' Anwendungs- oder objektdefinierter Fehler
Vielen Dank im Vorraus.
Private Sub CommandButton3_Click()
'Momentaufnahme
Sheets("Aktuell_Graphische Auswertung").Activate
Sheets("Aktuell_Graphische Auswertung").Range("B1:C8").Select
Selection.Copy
Sheets.Add
Sheets("Tabelle1").Name = "Neu"
ActiveSheet.Range("B1").Activate
ActiveSheet.Paste
Sheets("Neu").Range("A1").Activate
Sheets("Aktuell_Graphische Auswertung").Activate
Sheets("Aktuell_Graphische Auswertung").Range("A1:A8").Select
Selection.Copy
Sheets("Neu").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Range("D1").Activate
Sheets("Aktuell_Graphische Auswertung").Activate
ActiveSheet.Range("D1").Activate
ActiveSheet.Range("A1").Activate
ThisWorkbook.Sheets("Aktuell").Activate
'Auswerten
Dim endup1 As Integer
Dim i As Integer
endup1 = ThisWorkbook.Sheets("Aktuell").Range("A65536").End(xlUp).Row
Application.EnableEvents = False
For i = 8 To endup1
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.01.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Januar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.02.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Februar").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.03.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("März").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.04.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("April").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.05.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Mai").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.06.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Juni").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.07.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Juli").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.08.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("August").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.09.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("September").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.10.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Oktober").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.11.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("November").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
If ThisWorkbook.Sheets("Aktuell").Range("H" & i) Like "*.12.*" Then
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Copy Destination:=ThisWorkbook.Sheets("Dezember").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.Sheets("Aktuell").Range("H" & i).entirerow.Delete shift:=xlUp
End If
Next i
Application.EnableEvents = True
Sheets("August").Activate
ActiveSheet.Columns("A:J").EntireColumn.AutoFit
ActiveSheet.Range("A6", Cells(Rows.Count, 1).End(xlUp).Offset(0, 9)).Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Sheets("August").Activate
ActiveSheet.Range("A1").Activate
Sheets("Neu").Activate
ActiveSheet.Range("A1:C8").Select
Selection.Copy
Sheets("August").Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Activate
ActiveSheet.Paste
Sheets("Neu").Activate
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End Sub