Kopieren von Werten
13.12.2006 15:36:13
Werten
ich brauch mal wieder eure Hilfe. Ich habe eine Basisdatei und eine Zieldatei und nun möchte ich mir einige Daten von der Basis- in die Zieldatei. In der Basisdatei stehen im Bereich A6 bis A20 Jahreszahlen. Jedes Jahr kommt eine Zeile dazu, was im unten angeführten Beispiel durch die IF-Anweisungen beachtet wurde. Durch eine Auswahl in der Userform wird das Jahr festgelegt, dessen Werte ich benötige. Wenn ich also die Werte von 2005 brauch, soll mir das Programm in der Basisdatei (Tabellenblatt 1.1) in Spalte A (Zellen A6:A20) nach diesem Jahr suchen und dann die Werte aus Spalte B bis W der gleichen Zeile in die Zieldatei kopieren.
In der Zieldatei (Tabellenblatt TAB 11) müssen die Werte untereinander von B6 bis B26 stehen.
Kann mir dabei bitte jemand helfen. Folgende Überlegung hab ich bereits versucht, aber so funktioniert es nicht.
Sub Datenkopieren()
Dim wbBasis As Workbook, wbZiel As Workbook
Dim rngBasis As Range, rngZiel As Range, Zelle As Range
Dim c As Integer
Dim b As Integer
Set wbBasis = Workbooks("Basisdatei.xls")
Set wbZiel = Workbooks("Zieldatei.xls")
c = UserForm1.ComboBoxJahre.ListIndex
'Datenbereich in Basis
'über if-Abfrage Range-Zuweisung, um Bereich variabel zu halten
If c = 0 Or c = 1 Then
b = 2005
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W20")
ElseIf c = 2 Then
b = 2006
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W21")
ElseIf c = 3 Then
b = 2007
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W22")
ElseIf c = 4 Then
b = 2008
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W23")
ElseIf c = 5 Then
b = 2009
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W24")
ElseIf c = 6 Then
b = 2010
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W25")
ElseIf c = 7 Then
b = 2011
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W26")
ElseIf c = 8 Then
b = 2012
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W27")
ElseIf c = 9 Then
b = 2013
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W28")
ElseIf c = 10 Then
b = 2014
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W29")
ElseIf c = 11 Then
b = 2015
Set rngBasis = wbBasis.Worksheets("1.1").Range("A6:W30")
End If
'Daten im Bereich für Ergebnisse löschen
wbZiel.Worksheets("TAB 11").Range("B6:B26").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, 1, False)
Next
End Sub
Gruss
Andreas