Mehrfache Filterung - Unterschiedliches Einfügen
05.01.2004 15:45:38
Gorginio
Ich habe folgendes Problem:
Ein Tabellenblatt dient als Eingabetabelle, Wobei die ersten 3 Zeilen für die Überschriften gebraucht werden.
Das folgende Makro soll dann folgendes machen: In der ersten Spalte habe ich Laender (von dropdown liste) und in der 2. sind Bundeslaender (von dropdown liste), fuer die ich jeweils 1 Tabellenblatt habe. Nachdem alle Eintraege in der "INSERT HERE" Tabelle vorgenommen worden sind, soll mittels makro die Länder und Bundesländer überprüft werden und die restlichen Daten (in den nächsten Spalten) in das richtige Tabellenblatt geschrieben werden, wobei die Anordnung der Zellen dort jeweils unterschiedlich ist.
Anbei der Code, der mir immer einen out of range error gibt und ich weiss nicht wieso, vielleicht kann mir jemand einen Tip geben,
Dankevielmals im Vorraus.
Option Explicit
Option Base 1
Sub choose()
Dim Data_array() As Variant
Dim numberrow As Variant
Dim l, m, n As Integer
Dim i, j As Integer
Sheets("INSERT HERE").Activate
numberrow = Cells(Rows.Count, 1).End(xlUp).Row
ReDim Data_array(1 To numberrow, 1 To 36)
i = 1
j = 4
For i = 1 To numberrow Step 1
Data_array(i, 1) = Cells(j, 1).Value
Data_array(i, 2) = Cells(j, 2).Value
Data_array(i, 3) = Cells(j, 3).Value
Data_array(i, 4) = Cells(j, 4).Value
Data_array(i, 5) = Cells(j, 5).Value
Data_array(i, 6) = Cells(j, 6).Value
Data_array(i, 7) = Cells(j, 7).Value
Data_array(i, 8) = Cells(j, 8).Value
Data_array(i, 9) = Cells(j, 9).Value
j = j + 1
Next i
m = 51
n = 72
For l = 1 To numberrow Step 1
If Data_array(i, 1) = "Tirol" And Data_array(i, 2) = "Austria" Then
Sheets("AT-Tirol").Activate
Cells(m, 3) = Data_array(i, 3)
m = m + 1
ElseIf Data_array(i, 1) = "Salzburg" And Data_array(i, 2) = "Austria" Then
Sheets("AT-Salzburg").Activate
Cells(m, 3) = Data_array(i, 3)
n = n + 1
End If
Next l
End Sub