Office: (Office 2010) 2 Mappen Vergleichen

Hallo Kollegen,

Ich bin Totale Neuling in Forum und in VBA, hoffe eure Hilfe .

Es gibt 2 Mappen mit fehlenden Daten Mappe1 und mit richtigen Daten Mapp2.

1) Mappe1 TabelleZ fehlende Daten zb. 114

2) Mappe2 mit vielen Tabellen mit richtigen Daten (Jeder Tabelle ist Nummeriert zb. 114.

3) Beide Mappen sind offen Mappe1 wir über Inputbox Aktiviert.

4) Ich habe versucht Zeilen aus Mappe1 TabelleZ nach 2 Kriterien in Mappe2 zusuchen bei Fund fehlende Werte in die Mappe1 TabelleZ zu übertragen.

5) Zuerst habe ich Blattnummer 114 aus Mappe1 TabelleZ Spalte 9 gelesen und in Mappe2 zwei nach 114 gesucht ers da drin die Kriterien abgefragt.

Ist aber nicht ganz gelunge hoffe ihr könnt mir weiter Helfen.

Gruß

Ridvan


Sub AUSWAHLMENÜ_Schaltfläche10_Klicken()
Dim wksZ As Worksheet
Dim wksQ As Worksheet

Dim wkbZ As Workbook
Dim wkb1 As Workbook

Dim z As Long
Dim q As Long
Dim sucheI As Variant
Dim sucheO As Variant
Dim sucheE As Variant
'Dim sucheAM As Variant
Dim letztez As Long
Dim letzteq As Long
Dim Zelle As Range
Dim iCounter, iRowU As Integer
Dim fname$, testn$
fname = InputBox("ArtikelNummer eingeben!" & vbCr & "Die Excel-Datei wird dann geladen.")
fname = "C:\Page\" & fname & ".xls"
testn = Dir(fname)

Set wksZ = Workbooks(testn$).Worksheets("TabelleZ") 'Anpassen!!!!!!!!
Set wksQ = Workbooks("Mappe2.xlsx").Worksheets("001") 'Anpassen!!!!!!!!

For letztez = 4 To Workbooks(testn$).Worksheets("TabelleZ").Range("A65536").End(xlUp).Row
For letzteq = 4 To Workbooks("Mappe2").Worksheets("001").Range("A65536").End(xlUp).Row

sucheI = wksZ.Cells(letzteq, 9)
sucheE = wksZ.Cells(letzteq, 10)
sucheO = wksZ.Cells(letzteq, 15)
If sucheI = " " Then
End If
Worksheets(sucheI).Activate

If sucheE = " " Then
End If
Set Zelle = wksZ.Range("E" & letzteq & ":" & "EP" & letzteq).Find(What:=sucheE, LookIn:=xlValues, lookat:=xlWhole)
If Not Zelle Is Nothing Then
Zelle = sucheE
End If
If sucheO = " " Then
End If
Worksheets(sucheI).Activate
Set Zelle = wksZ.Range("E" & letzteq & ":" & "EP" & letzteq).Find(What:=sucheO, LookIn:=xlValues, lookat:=xlWhole)
If Not Zelle Is Nothing Then
Zelle = sucheO
If Not Zelle Is Nothing Then
End If
wksZ.Cells(Zelle.Row, 37).value = wksQ.Cells(letzteq, 8).value
wksZ.Cells(Zelle.Row, 38).value = wksQ.Cells(letzteq, 9).value
wksZ.Cells(Zelle.Row, 39).value = wksQ.Cells(letzteq, 10).value
End If
Next
Next letztez
Set wksQ = Nothing
Set wksZ = Nothing
Application.ScreenUpdating = True
End Sub