Suchen und Kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
das sollte mit dem folgenden Makro gehen. Es müssen aber bitte noch einige fehlen de Angaben von dir ergänzt werden!!
Nicht angegeben war die Spalte in MS und MK wo der Sortenname zum suchen steht. Bei For Each AC In MSE.Range("A2:A" & lzMS) muss statt "A" die Spalte angegeben werden wo der Suchbegriff steht. Und bei Set rFind = MKE.Columns("A").Find(What:=AC, After:=MKE.Range("A1") muss die Columne und die erste Zelle zum Suchen mit Find angegeben werden. Hier fehlt noch die Spalte wo die Daten für "B" herkommen: MKE.Cells(AC.Row, "B") = MSE.Cells(rFind.Row, "xx") 'xx->B
Mit diesen Angaben sollte das Makro laufen. Würde mich freuen wenn es einwandfrei klappt.
mfg Piet

Const MSErtrag = "MS_Ertragseigenschaften.xlsx" 'B,I,J -> C,O,P
Const MKErtrag = "MK_Ertragseigenschaften.xlsx" 'B -> ?


Sub ÜberKreuz_Kopieren()
Dim AC As Range, rFind As Range
Dim MSE As Worksheet, lzMS As Long
Dim MKE As Worksheet, lzMK As Long
Set MSE = Workbooks(MSErtrag).Worksheets("Tabelle xxx")
Set MKE = Workbooks(MKErtrag).Worksheets("Tabelle xxx")
'Lastzell in MS * Mk ermitteln
lzMS = MSE.Cells(Rows.Count, "A").End(xlUp).Row
lzMK = MKE.Cells(Rows.Count, "A").End(xlUp).Row
'MS Datei Sortenspalte in MK durchsuchen (hier Spalte A)
For Each AC In MSE.Range("A2:A" & lzMS)
'** Suchspalte in MK bitte selbst festlegen!!
Set rFind = MKE.Columns("A").Find(What:=AC, After:=MKE.Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
'Daten aus MK nach MS kopieren  Spalten prüfen!
MSE.Cells(AC.Row, "C") = MKE.Cells(rFind.Row, "B")   'B->C
MSE.Cells(AC.Row, "O") = MKE.Cells(rFind.Row, "I")   'I->O
MSE.Cells(AC.Row, "P") = MKE.Cells(rFind.Row, "J")   'J->P
End If
Next AC
'MK Datei Sortenspalte in MS durchsuchen (hier Spalte A)
For Each AC In MKE.Range("A2:A" & lzMK)
'** Suchspalte in MS bitte selbst festlegen!!
Set rFind = MSE.Columns("A").Find(What:=AC, After:=MSE.Range("A1"), _
LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
'Daten aus MK nach MS kopieren  Spalten prüfen!
MKE.Cells(AC.Row, "B") = MSE.Cells(rFind.Row, "xx")   'xx->B
End If
Next AC
End Sub

Hallo Piet,
hab da noch Fragen.
1. For Each AC In MSE.Range("A2:A" & lzMS) ~f~ Muss ich da die letzte Zeile eingeben (258) oder A258? Die Sorten stehen immer in Spalte A. In MS_Ertragseigenschaften.xlsx sind es 257 in MK_Ertragseigenschaften.xlsx sind es 187. Ist das dann egal?
2. Hast Du die beiden Arbeitsmappen umbenannt? Im Makro steht Workbooks MSErtrag und auch Worksheets MKErtrag. Ich hatte ja die 2 Excel Dateien hochgeladen.
3. Und bei ~f~Set rFind = MKE.Columns("A").Find(What:=AC, After:=MKE.Range("A1") ~f~ muss die Columne und die erste Zelle zum Suchen mit Find angegeben werden. Hier fehlt noch die Spalte wo die Daten für "B" herkommen: ~f~ MKE.Cells(AC.Row, "B") = MSE.Cells(rFind.Row, "xx") 'xx->B
Ich glaube, dass ich mich hier vertan habe. Ich brauche in MK_Ertragseigenschaften.xlsx die Zahlen aus der Spalte B von MS_Ertragseigenschaften.xlsx. Die müssen dann in Spalte C
Gruß Marko
https://www.herber.de/bbs/user/151013.xlsx
https://www.herber.de/bbs/user/151014.xlsx

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Suchen und Kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread