Kreuzabfrage
10.07.2014 14:43:59
Bon
in meiner Quelltabelle stehen in der Spalte A Indizes. In der 4. Zeile stehen Monatsnamen (Januar - Dezember).
Nun möchte ich, wenn in B2 meiner Zieltabelle ein Monat erscheint (z.B. Januar), auch nur die Spalte Januar in mein Ziel-Tabellenblatt kopiert wird.
Der Code, den ich gefunden habe, kopiert nur fest vorgegebene Spalten.
Habt ihr Ideen, wie man dieses Problem lösen kann?
Danke im voraus!
Sub Übertragen()
Dim colDummy As Collection
Dim colZeilen As New Collection
Dim i As Long
Dim k As Long
Dim strSearch As String
Dim varDummy As Variant
Dim wsZiel As Worksheet
Dim wsQuelle As Worksheet
Dim dtmBeginn As Date
On Error Resume Next
dtmBeginn = Now
Set wsZiel = Worksheets("Tabelle1")
Set wsQuelle = Worksheets("Tabelle2")
With wsZiel 'Zieldatenblatt
For i = 1 To 650
strSearch = CStr(.Cells(i, 1))
If strSearch "" Then
Set colDummy = New Collection
colZeilen.Add colDummy, "X-" & strSearch
colZeilen("X-" & strSearch).Add i, "Zielzeile"
End If
Next
End With
With wsQuelle 'Tabelle mit allen Daten
For i = 1 To 650
strSearch = CStr(.Cells(i, 1))
If strSearch "" Then
colZeilen("X-" & strSearch).Add i, "Quellzeile"
End If
Next
End With
With wsZiel 'Zieldatenblatt
Application.ScreenUpdating = False
For Each varDummy In colZeilen
i = varDummy("Zielzeile")
k = varDummy("Quellzeile")
'Kopiert von 1. bis 7.Spalte -> soll aber nur eine bestimmte Spalte kopiert werden
.Range(.Cells(i, 1), .Cells(i, 7)).Value = _
wsQuelle.Range( _
wsQuelle.Cells(k, 1), wsQuelle.Cells(k, 7) _
).Value
Next
Application.ScreenUpdating = True
End With
End Sub