Werte kopieren - knifflig
15.02.2007 15:36:54
Andreas
ich hab folgendes Problem:
Ich hab eine Basisdatei mit einer Vielzahl von Tabellenblättern. Jedes einzelne Tabellenblatt ist aus mehreren Blöcken aufgebaut. In jedem Block gibt es Jahreszahlen mit den entsprechenden Werten in den Spalten. Die Datei wird jedes Jahr fortgeschrieben, d.h. dass die Blöcke jedes Jahr größer werden. Stehen jetzt in den Zeilen 6 bis 20 (erster Block) die Werte von 1991 bis 2005, so kommt im nächsten Jahr eine Zeile in diesem Block dazu. Dadurch verändern sich aber auch die anderen Blöcke der zweite Block beginnt dann erst eine Zeile später und geht 2 Zeilen weiter.
Ich wollte die Exceldatei hochladen (<300kB), aber da gab es immer eine Fehlermeldung.
Aufgabe ist es nun, Werte zu kopieren. Ich habe eine Berichtsdatei, in die ich die Werte aus der 6. Spalte kopieren will. Dazu vergleiche ich die Zellen der Basisdatei mit den Jahreszahlen mit den Spalten der Zieldatei, wo ebenfalls einige Jahre aufgelistet sind (immer 10 Jahre). Wo Übereinstimmungen sind, sollen Werte kopiert werden.
Realisiert habe ich das Kopieren wie folgt:
Sub Kopieren()
Set wbBasis = Workbooks("Test-Beispiel.xls")
Set wbZiel = Workbooks("Zieldatei.xls")
c = UserForm1.ComboBoxJahre.ListIndex
' Werte für TAB 1 erste Zeile
'Datenbereich in Basis
'über if-Abfrage Range-Zuweisung, um Bereich variabel zu halten
If c = 0 Or c = 1 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N20")
ElseIf c = 2 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N21")
ElseIf c = 3 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N22")
ElseIf c = 4 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N23")
ElseIf c = 5 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N24")
ElseIf c = 6 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N25")
ElseIf c = 7 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N26")
ElseIf c = 8 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N27")
ElseIf c = 9 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N28")
ElseIf c = 10 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N29")
ElseIf c = 11 Then
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:N30")
End If
'Bereich mit Jahreszahlen in Zieltabelle
Set rngZiel = wbZiel.Worksheets("TAB 1").Range("B3:K3")
On Error Resume Next
'Daten im Bereich für Ergebnisse löschen
wbZiel.Worksheets("TAB 1").Range("B5:K5").ClearContents
'Werte in dem Ergebnisbereich eintragen mit Tabellenfunktion VLookup (SVERWEIS)
For Each Zelle In rngZiel
Zelle.Offset(2, 0).Value = Application.WorksheetFunction.VLookup(Zelle.Value, rngBasis, 6, False)
Next
End Sub
Die c-Werte ergeben sich durch das Eingabeformular und bestimmen, welche Jahre in der Zieldatei angezeigt werden sollen. Für den zweiten Block in der Basisdatei ist Range dann A22:A35, A23:A37,
Die Methode funktioniert zwar, aber ist extrem aufwendig beim Erstellen und Pflegen, weil so viel eher Fehler auftreten können. Nun meine Bitte:
Kann mir jemand helfen, dass ich das viel einfacher machen kann, also dass z. B. die Blöcke anders angesprochen werden und vor allem noch variabler.
Hat jemand einen Vorschlag?
Gruss
Andreas