Datum vergleichen und Spalte kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Bernd,
tut mir leid ich bin noch etwas neu, im Anhang die 2 Excel-Dateien.
https://www.herber.de/bbs/user/135449.zip
Zum einen findet sich meine Frage aus dem Eingangs-Post.
Zusätzlich habe ich noch eine Frage das genau anders herum zu lösen.
Als kurze Erklärung:
In Mappe 1 gibt es immer nur die eine Spalte wo per Dropdown Januar bzw. Februar oder März... eingetragen wird.
Darauf hin sucht er die Spalte in Mappe2 und fügt die Zahlen unter den entsprechenden Monat ein.
Die 2. Tabelle hat nur die kleine Tabelle - hier als Beispiel JP mit entsprechenden Werten unter A B C D
Diese Werte sollen dann in Mappe 2 in die entsprechende Zeile angefügt werden (je nachdem ob z.B. in Mappe 1 KW1 KW2 oder KW3 ausgewählt ist.
Der Aufbau der Zieldatei Mappe2 ist immer gleich. Das bedeutet ich bräuchte hierfür eine Art
"Suche KW(XY) - Wenn KW(XY) gefunden ist kopiere Daten unter A B C D E in Spalte i+2 (da JP ja immer an 2. Stelle nach ES kommt).
Mein Code für die Eingangsfrage hilft mir nur bedingt weiter, ich saß gestern bis um 5 Uhr morgens noch dran und bekomme es einfach nicht gelöst :(
Ich hoffe wirklich meine Erklärung hilft und bedanke mich schon mal für Deine/Eure Zeit!
Beste Grüße
Markus

Servus markus,
für deine erste Frage teste mal das hier:


Private Sub werte_uebergeben_Click()
Dim WkSh_Q As Worksheet
Dim WkSh_Z As Worksheet
Dim WBZ As Workbook
Dim rZelle As Range, rZiel As Range
Dim aUeberschr As Variant
Dim iIndx As Integer
aUeberschr = Array("Januar", "Februar", "March", "April", "Mai")
Application.ScreenUpdating = False
Set WkSh_Q = ThisWorkbook.Sheets("Tabelle1") ' das Quell-Tabellenblatt
Set WBZ = Workbooks.Open("C:\Test\Mappe2.xlsx") ' Dateipfad anpassen!!!
Set WkSh_Z = WBZ.Worksheets("Tabelle1") ' das Ziel-Tabellenblatt
For iIndx = 0 To UBound(aUeberschr)
Set rZelle = WkSh_Q.Rows(1).Find(aUeberschr(iIndx), lookat:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
Set rZiel = WkSh_Z.Rows(1).Find(aUeberschr(iIndx), lookat:=xlWhole, LookIn:= _
xlValues)
If Not rZiel Is Nothing Then
rZelle.Range("A1:A11").Copy Destination:=rZiel
Exit For
End If
End If
Next iIndx
WBZ.Close True
Set WkSh_Z = Nothing
Set WBZ = Nothing
Set WkSh_Q = Nothing
Application.ScreenUpdating = True
End Sub

Zu deiner zweiten Frage habe ich mal folgendes gebastelt:


Sub test()
Dim WkSh_Q As Worksheet
Dim WkSh_Z As Worksheet
Dim WBZ As Workbook
Dim Start As Integer
Dim Ende As Integer
Dim rZelle As Range
Dim rZiel As Range
Application.ScreenUpdating = False
Set WkSh_Q = ThisWorkbook.Sheets("Tabelle1") ' das Quell-Tabellenblatt
Set WBZ = Workbooks.Open("C:\Test\Mappe2.xlsx") ' Dateipfad anpassen!!!
Set WkSh_Z = WBZ.Worksheets("Tabelle1") ' das Ziel-Tabellenblatt
Set rZelle = WkSh_Z.Columns(6).Find(what:=WkSh_Q.Range("D24"), lookat:=xlWhole, LookIn:= _
xlValues)
If Not rZelle Is Nothing Then
Start = rZelle.Row + 1
Ende = WkSh_Z.Cells(Start, 6).End(xlDown).Row
Set rZiel = WkSh_Z.Range("F" & Start & ":F" & Ende).Find(what:=WkSh_Q.Range("D25"),  _
lookat:=xlWhole, LookIn:=xlValues)
If Not rZiel Is Nothing Then
WkSh_Q.Range("E25:I25").Copy Destination:=WkSh_Z.Cells(rZiel.Row, 7)
End If
End If
WBZ.Close True
Set WkSh_Z = Nothing
Set WBZ = Nothing
Set WkSh_Q = Nothing
End Sub

Ich hoffe, das entspricht deinen Erwartungen. Feedback wäre nett.
Grüße, Bernd

Beliebteste Forumthreads (12 Monate)

Datum vergleichen und Spalte kopieren

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Datum vergleichen und Spalte kopieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread