VBA wie "sverweis" automatisch ausfüllen

Hallo Leute,
um mir viel Arbeit in Zukunft zu sparen dachte ich an ein kleines Makro das mir helfen könnte.
Ich bin leider nur vertraut mit dem Makrorekorder, der mir an der stelle aber nicht hilft.
Hierzu eine Beispieldatei bei der die Positionen der Original Datei entsprechen. Die Tabelle ist normalerweise aber deutlich länger: https://www.herber.de/bbs/user/154655.xlsm
Was ich mir wünsche:
1. Das Makro soll die Dateien Aus der Tabelle auf "Tabelle1" in "Cluster" ziehen. Jeder Match ist in Cluster schon vorhanden und muss nicht angefügt werden.
2. Werte die schon vorhanden sind sollen nicht geändert werden.
3. Es kann sein das in Cluster in einer Zeil schon einzeln Werte stehen, da sollen die noch nicht vorhandenen nachgetragen werden.
Mit 1. und 2. wäre ich schon sehr glücklich. Bei 3. weiß ich gar nicht ob das so leicht umsetzbar ist.
Ich hoffe ich habe mich verständlich genug ausgedrückt. Weiß einer wie man da vorgehen könnte und kann mir helfen?
Lieben Dank :)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi,
teste mal diesen Code. Ich habe mich genau an Deine Spalten gehalten (Übertragungswerte in Tabelle 1 stehen ab Spalte 49 und sollen in Cluster ab Spalte 5 eingetragen werden). Wenn das nicht so passt, musst Du die Werte für die Spalten ändern.


Public Sub uebertrag()
Dim obj_wks_ziel As Worksheet
Dim obj_wks_quelle As Worksheet
Dim lng_letzte_zeile As Long
Dim lng_zeile_ziel As Long
Dim lng_zeile_quelle As Long
Dim lng_spalte_ziel As Long
Dim lng_spalte_quelle As Long
Dim rng_fund As Range
Set obj_wks_ziel = ThisWorkbook.Worksheets("Cluster")  ' Hier Zieltabellenblatt benennen
Set obj_wks_quelle = ThisWorkbook.Worksheets("Tabelle1")  ' Hier Quelltabellenblatt benennen
With obj_wks_quelle
lng_letzte_zeile = .Cells(Rows.Count, 36).End(xlUp).Row - 1
For lng_zeile_quelle = 5 To lng_letzte_zeile
Set rng_fund = obj_wks_ziel.Columns(4).Find(.Cells(lng_zeile_quelle, 36), LookIn:=xlValues, lookat:=xlWhole)
If Not rng_fund Is Nothing Then
lng_spalte_quelle = 49
For lng_spalte_ziel = 5 To 10
If obj_wks_ziel.Cells(rng_fund.Row, lng_spalte_ziel) = "" Then
obj_wks_ziel.Cells(rng_fund.Row, lng_spalte_ziel) = .Cells(lng_zeile_quelle, lng_spalte_quelle)
End If
lng_spalte_quelle = lng_spalte_quelle + 1
Next
End If
Next
End With
End Sub

Gruß Regina

Public Sub uebertrag() Dim obj_wks_ziel As Worksheet Dim obj_wks_quelle As Worksheet Dim lng_letzte_zeile As Long Dim lng_zeile_ziel As Long Dim lng_zeile_quelle As Long Dim lng_spalte_ziel As Long Dim lng_spalte_quelle As Long Dim rng_fund As Range Set obj_wks_ziel = ThisWorkbook.Worksheets("Cluster") ' Hier Zieltabellenblatt benennen Set obj_wks_quelle = ThisWorkbook.Worksheets("Tabelle1") ' Hier Quelltabellenblatt benennen With obj_wks_quelle lng_letzte_zeile = .Cells(Rows.Count, 36).End(xlUp).Row - 1 For lng_zeile_quelle = 5 To lng_letzte_zeile Set rng_fund = obj_wks_ziel.Columns(4).Find(.Cells(lng_zeile_quelle, 36), LookIn:=xlValues, lookat:=xlWhole) If Not rng_fund Is Nothing Then lng_spalte_quelle = 49 For lng_spalte_ziel = 5 To 10 obj_wks_ziel.Cells(rng_fund.Row, lng_spalte_ziel) = .Cells(lng_zeile_quelle, lng_spalte_quelle) lng_spalte_quelle = lng_spalte_quelle + 1 Next End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

VBA wie "sverweis" automatisch ausfüllen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

219 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA wie "sverweis" automatisch ausfüllen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

219 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread