VBA Suchfunktion

[andywww2]

Hallo Zusammen,


folgendes Problem. Ich habe eine " Daten" diese ist mit einer Datenbank verbunden und aktualisiert sich selber. In dieser Tabelle sind
Werte die ich gerne in einer andere Tabelle durch eine Suchfunktion kopieren möchte. Es sollen alle Werte in die Tabelle kopiert werden
die "gefunden" wurden. Dies soll aber in einem Bestimmten breich passieren.

Mein derzeitiger Code kopiert mir alle Spalten und Zeilen die er gefunden hat in eine neue Tablle.

Bsp: Daten Tabelle 1 ( Daten )

ID   Lieferant  StandortNummer  Netzelementnummer  StandortName  StandortPLZ  StandortStrasse   Hersteller  Typenbezeichnung   ItemCode    HWRevision  Serienummer  User
12   Nokia          1111111                       121212                  Berlin             00000              KarlAllee           Nokia           FPMA                    44444           8888           88888

Code:

Code:

Dim loDeinWert As Long
Dim sFirstAdress As String


loDeinWert = 11994759 'gesuchter Wert

Set rng = Worksheets("Tabelle1").Range("C:D").Find(loDeinWert)

If rng Is Nothing Then
 MsgBox "Wert " & loDeinWert & " nicht gefunden!"
Else
 sfirstaddress = rng.Address
 Do
   rng.EntireRow.Copy
   Worksheets("Tabelle3").Cells(Rows.Count, "A").End(xlUp) _
     .Offset(1, 0).PasteSpecial Paste:=xlPasteAll
   Set rng = Worksheets("Tabelle1").Range("C:D").FindNext(rng)
 Loop While Not rng Is Nothing And rng.Address <> sfirstaddress
End If

End Sub

Dieser Code kopiert mir den Fund in die neue Tabelle3.

Ich möchte aber nur den Breich von Hersteller bis Seriennummer in die neue Tabelle kopiert haben.
Mein Problem dazu ist noch ich möchte das nicht am Anfang der Tabelle haben sondern ab B10.


Hat einer dazu eine Lösung?

[Steffl]

Hallo,

mal ungetestet

Code:

Sub prcX()

Dim loDeinWert As Long
Dim sFirstAdress As String


loDeinWert = 11994759 'gesuchter Wert

Set Rng = Worksheets("Tabelle1").Range("C:D").Find(loDeinWert)

If Rng Is Nothing Then
MsgBox "Wert " & loDeinWert & " nicht gefunden!"
Else
sfirstaddress = Rng.Address
Do
   Cells(Rng.Row, 7).Resize(, 5).Copy
'   Rng.EntireRow.Copy
   Worksheets("Tabelle3").Cells(Rows.Count, "A").End(xlUp) _
     .Offset(1, 0).PasteSpecial Paste:=xlPasteAll
   Set Rng = Worksheets("Tabelle1").Range("C:D").FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> sfirstaddress
End If


End Sub

[andywww2]

Vielen Dank für deine Hilfe.

Leider bringt dein Script ein Laufzeitfehler 9  ( Ausßerhalb des gültigen Bereich ).

Ich habe mal die Excel Datei mit Angehangen.
Dort kann man genau sehen um was es geht.


 In der Tabelle Daten steht immer in der Spalte "C" die Standortnummer nach der gesucht werden soll.
Wenn die Standort Nummer mit der gesuchten Standortnummer übereinstimmt dann sollen die Werte aus der Spalte H bis L  in eine neue Tabelle ( LIEFERSCHEIN ) kopiert werden.
Die Daten sollten aber nicht in der Tabelle2(Lieferschein) bei Zeile 1 und Spalte A reinkopiert werden sondern sollen ab Spalte B und Zeile 5 rein kopiert werden.

Leider habe ich keinen Ansatz oder zu wenig erfahrung mit VBA ... mit Php geht es  bei mir besser :D

[Steffl]

Hallo,

ich habe mir deine Datei jetzt nicht heruntergeladen aber der Laufzeitfehler kommt auch wenn der Tabellenname nicht existiert. In deinem Makro heißen die beiden beteiligten Tabellenblätter Tabelle1 und Tabelle3. Wenn die Tabellenblätter aber wie von dir angegeben Lieferschein heißen, kommt es natürlich zum Fehler. Passe die Namen auf die tatsächlichen an und dann dürfte es gehen.

[andywww2]

Hey,


habe nun die Namen angepasst leider passiert nichts.
Das Script scheint zulaufen aber es werden keine Daten abgelegt.

[Gast 123]

Hallo,

ich denke so müsste das Makro laufen. Die Zuordung der Tabellen Namen stimmte nicht !!  Für das Makro darf man nicht die Namen aus dem VBA Editor nehmen, Tabelle1, 2, das klappt nicht!  Hier benötigt man die Namen so wie sie unten in der Reiterleiste stehen:  "DATEN" und "LIEFERSCHEIN"  Kopieren ab Zelle B5 wurde auch geaendert.  Bitte ausprobieren.  VBA ist kein Dschungel Wissen, man muss den Code nur erlernen ...

mfg  Gast 123 

Code:

Sub prcX()
Dim laZell As Long
Dim loDeinWert As Long
Dim sFirstAdress As String

loDeinWert = 11994759 'gesuchter Wert

'alten Lieferschein löschen
Worksheets("LIEFERSCHEIN").Range("B5:F500").Clear

Set Rng = Worksheets("DATEN").Range("C:D").Find(loDeinWert)

If Rng Is Nothing Then
MsgBox "Wert " & loDeinWert & " nicht gefunden!"
Else
sfirstaddress = Rng.Address
Do  
  laZell = Worksheets("LIEFERSCHEIN").Cells(Rows.Count, 2).End(xlUp).Row + 1
  If laZell < 5 Then laZell = 5   '1. Zeile minimum auf B5 setzen
  Worksheets("DATEN").Cells(Rng.Row, 7).Resize(1, 5).Copy
  Worksheets("LIEFERSCHEIN").Range("B" & laZell).PasteSpecial Paste:=xlPasteAll
  Application.CutCopyMode = False  'Kopie Modus löschen !!
  Set Rng = Worksheets("DATEN").Range("C:D").FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> sfirstaddress
End If
End Sub

[Gast 123]

Nachtrag:

dieses Makro sucht immer nur einen bestimmten Wert, er ist nicht veraenderbar!!  Ist das so gewünscht???
Sonst muss man ihn aus einer Zelle laden, s. Beispiel unten,  über über eine InputBox als Eingabe.
loDeinWert = Worksheets("LIEFERSCHEIN").Range("B1").Value

[andywww2]

Hallo Zusammen,


Vielen Dank für die Hilfe das Programm funktioniert.
Habe es auch nun so anpasen können wie ich es brauch.

Einwas muss noch suchen. Das währe nur das beim "kopieren" die "Zellen formatierung" nicht
mit kopiert werden muss/soll.

[Gast 123]

Hallo,

sehr einfach, siehe diesen Befehl   Paste:=xlPasteAll
ersetze ihn durch  xlPasteValues   das ist alles.   xlPastAll kopiert Alles, mit Formate, Rahmen, xlValues kopiert nur Werte!!

mfg  Gast 123