code problem...die zweite

hallo, leider habe ich das nächste problem mit meinem kleinen vba-code. so ganz firm bin ich in der materie nicht, aber nur so wirds was...
also mal kurz zu meinem ziel
ich habe zwei tabellen
nun soll über das makro folgendes passieren
nimm den wert aus zelle f1 (Tabelle 1) und suche in der tabelle 2 in spalte g nach dem gleichen wert, wenn er gefunden wurde, dann schneide die zeile mit dem suchwert (in diesem fall zeile 1) aus füge sie in tabelle 3 und schneide dann den gefundenen wert aus tabelle2 aus und füge in ebenfalls in tabelle 3 ein (unter demvorher eingefügten wert).
mein vba code macht folgendes:
es sucht und findet den wert, aber kopiert nicht den zielwert aus tabelle2, es nimmt einfach gleiche zeile aus tabelle 1 nur in tabelle 2, z.b.
in tabelle1 F1 ist der suchwert und in tabelle2 wird dieser auch gefunden, dann wird Zeile 1 aus tabelle 2 eingefügt und nicht die zeile in der der gesuchte wert steht....
bischen konfus, ich hoffe man kann mich verstehen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

hier der code !

04.02.2004 19:34:27

stefan

AW: hier der code !

04.02.2004 19:52:04

Josef Ehrensberger

AW: hier der code !

04.02.2004 20:13:33

Stefan

Danke für die Rückmeldung! o.T.

04.02.2004 20:27:03

Josef Ehrensberger

Sub doppelte_DS_ausschneiden() For r = 1 To Cells(65536, 6).End(xlUp).Row Wert = Cells(r, 6) ' Suchspalte und Tabelle definieren With Sheets(2) Set C = .Columns(7).Find(Wert, LookIn:=xlValues, LookAt:=xlWhole) If Not C Is Nothing Then I = Sheets(3).Cells(65536, 1).End(xlUp).Row + 1 Range(Cells(r, 1), Cells(r, 10)).Cut Destination:=Sheets(3).Cells(I, 1) I = I + 1 Range(.Cells(r, 1), .Cells(r, 10)).Cut Destination:=Sheets(3).Cells(I, 1) End If End With Next r End Sub

Hallo Stefan!
Versuch's so.

Sub doppelte_DS_ausschneiden()
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim wksZ As Worksheet
Dim rng As Range
Dim rngF As Range
Dim lngE As Long
Dim lngEZ As Long
Set wks1 = Sheets("Tabelle1")
Set wks2 = Sheets("Tabelle2")
Set wksZ = Sheets("Tabelle3")
lngE = wks1.Cells(65536, 6).End(xlUp).Row
lngEZ = wksZ.Cells(65536, 1).End(xlUp).Row + 1
For Each rng In wks1.Range(wks1.Cells(11, 6), wks1.Cells(lngE, 6))
If rng <> "" Then
Set rngF = wks2.Columns(7).Find(rng, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngF Is Nothing Then
wks2.Range(wks2.Cells(rngF.Row, 1), wks2.Cells(rngF.Row, 10)).Cut wksZ.Cells(lngEZ, 1)
wks1.Range(wks1.Cells(rng.Row, 1), wks1.Cells(rng.Row, 10)).Cut wksZ.Cells(lngEZ + 1, 1)
lngEZ = lngEZ + 2
End If
End If
Next

Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread