suche in Ganzer Mappe

Hallo Liebe Gemeinde
Meine lange suche war vergebens.
Ich kann meinen fehler nicht finden.
Zum Programm:
Ich habe nummern in mappe1.tabelle2
Hinter jeder nummer steht ein kürzel zb:AB6
Diese daten brauche ich für eine listbox incl. Kürzel
Diese daten stammen jedoch aus einer anderen Mappe2
In Mappe2 schreiben verschiedene nutzer in verschiedenen tabellen in
Verschiedenen zellen diese nummer und änder die kürzel.
Klartext ich kann nicht mit verweis arbeiten um meine daten stets aktuell zu halten.
Ich suche daher einen code der meine nummer in besagter mappe2 durchsucht
Danach offset(0,1).copy "das ist das einzige was immer die gleiche position hat"
Und anschließend hinter meiner nummer in mappe1.tabelle2 kopiert.
Das habe ich probiert.
Workbooks.open filename.......
Dim wks as Workbook.Worksheets
Codeneu = sheets("tabelle2").Range("A01:A6000")
*diese zeile kann man bestimmt schöner schreiben
Cells.Find(Codeneu, After:=ActiveCell, LookIn:=xlvalues, Lookat:= _
XlWhole, SearchOrder:=xlbycolumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
.
.
.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Johann,
mit folgendem Makro, das du noch etwas anpassen musst, sollte die Suche und das Übertragen der Werte funktionieren.
Gruß
Franz

Sub Test()
Dim wkbZiel As Workbook
Dim wksZiel As Worksheet
Dim wkbQuelle As Workbook
Dim wksQuelle As Worksheet
Dim varDateiname As Variant
Dim Zelle_Z As Range, varWert As Variant
Dim Zelle_Q As Range
Dim StatusCalc As Long
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Worksheets("Tabelle2")
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte Datei mit gesuchten Daten auswählen"
If .Show = -1 Then
varDateiname = .SelectedItems(1)
Else
Exit Sub
End If
End With
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wkbQuelle = Application.Workbooks.Open(Filename:=varDateiname, ReadOnly:=True)
For Each Zelle_Z In wksZiel.Range("A1:A6000").Cells
If Zelle_Z  "" Then
varWert = Zelle_Z.Value
For Each wksQuelle In wkbQuelle.Worksheets
Set Zelle_Q = wksQuelle.Cells.Find(What:=varWert, LookIn:=xlValues, lookat:= _
xlWhole)
If Not Zelle_Q Is Nothing Then
Zelle_Z.Offset(0, 1).Value = Zelle_Q.Offset(0, 1)
Exit For
End If
Next
If Zelle_Q Is Nothing Then
Zelle_Z.Offset(0, 1).Value = "not found"
End If
End If
Next
wkbQuelle.Close savechanges:=False
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

suche in Ganzer Mappe

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

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread