Probleme mit selbstgeschriebenem Makro
03.07.2008 15:44:00
Jochen
hab folgende Aufgabenstellung:
Hab ne Exceldatei mit 2 Tabellenblättern Gesamtuebersicht und Handlungsfelder_makro. Aus der gesamtuebersicht sollen nun mittels 2 gesetzten Autofiltern bestimmte Werte eingelesen werden (Zellen D) und dann rüber in Handlungsfelder kopiert werden. Dort müssen sie in ein bestimmtes Muster (Schachbrettartig) einsortiert werden.
Leider wirft Excel nur mal wieder den Laufzeitfehler 1004 aus - damit kann ich leider recht wenig anfangen.
Wäre supernett wenn jemand kurz über den Code rüberschauen könnte und mir vielelicht Hilfestellung gibt, was an dem Code falsch sein könnte.
Die Formate sollten so wie ich das sehe passen (die Array Variant mache ich zum string durch cstring bzw. zuweisung zur Variable rang1).
Danke
Jochen
Sub CommandButton1_Click()
'Autofilter aktivieren
Worksheets("Gesamtuebersicht").Range("A2:T2").Select
Selection.AutoFilter
'Variablen | i= Zählvariable fuer Handlungsfelder | j = Zählvariable fuer Tabelle (alle 4 _
Zeilen neuer Eintrag)
'| X, Y = Variablen für Zelle (z.B. AX -> X=5 => A5) | ar1 = Array fuer Bewegung Zelle (z.B. B5 _
-> C5 ) fuer das pasten der Werte
Dim i As Integer
i = 3
Dim zaehler, zaehler2, zaehler3, zaehler4 As Integer
zaehler = 1
zaehler2 = 3
zaehler3 = 1
zaehler4 = 3
Dim rang1 As String
Dim j As Integer
Dim X, Y As Integer
Dim ar1 As Variant
Dim ar2 As Variant
Dim text, einlesen As String
text = Worksheets("Gesamtuebersicht").Range("A" + i).Value
ar1 = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", _
"S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB")
ar2 = Array("R", "GÜ", "K")
'Schleife bis alle Handlungsfelder durchlaufen
Do Until text = ""
Application.ScreenUpdating = False
rang1 = "A" & i
Selection.AutoFilter Field:=5, Criteria1:=CStr(Worksheets("Gesamtuebersicht").Range(rang1). _
Value)
'Schleife Region/GÜ/K
For zaehler = 1 To 3
Selection.AutoFilter Field:=4, Criteria1:=CStr(ar2(zaehler))
'Copy & Paste der stehenden Werte
Do Until einlesen = ""
If Rows(i).Hidden = False Then
rang1 = "D" & zaehler2
einlesen = Worksheets("Gesamtuebersicht").Range(rang1).Value
If zaehler = 1 Then
'Zeilenumbruch falls "J" erreicht und noch mehr Punkte
If zaehler3 = 9 Then
zaehler4 = zaehler4 + 1
zaehler3 = 1
End If
rang1 = CStr(ar1(zaehler3)) & zaehler4
Worksheets("Handlungsfelder_makro").Range(rang1).Value = einlesen
End If
If zaehler = 2 Then
'Zeilenumbruch falls "S" erreicht und noch mehr Punkte
If zaehler3 = 18 Then
zaehler4 = zaehler4 + 1
zaehler3 = 9
End If
'rang1 = CStr(ar1(zaehler3)) & zaehler4
Worksheets("Handlungsfelder_makro").Range(rang1).Value = einlesen
End If
If zaehler = 3 Then
'Zeilenumbruch falls "AB" erreicht und noch mehr Punkte
If zaehler3 = 27 Then
zaehler4 = zaehler4 + 1
zaehler3 = 18
End If
'rang1 = CStr(ar1(zaehler3)) & zaehler4
Worksheets("Handlungsfelder_makro").Range(rang1).Value = einlesen
End If
Else
zaehler2 = zaehler2 + 4
End If
zaehler2 = zaehler2 + 4
Loop
Next zaehler
i = i + 2
Loop
'AutoFilter deaktivieren
Selection.AutoFilter Field:=2
Selection.AutoFilter
'Screen wieder aktualisieren
Application.ScreenUpdating = True
End Sub