Das Archiv des Excel-Forums
VBA Suchen, kopieren, einfügen
- VBA Suchen, kopieren, einfügen von Aigo vom 18.09.2019 11:13:08
- AW: VBA Suchen, kopieren, einfügen - von Werner am 18.09.2019 11:44:30
- AW: VBA Suchen, kopieren, einfügen - von Aigo am 18.09.2019 12:16:25
- Lässt sich nicht öffnen. o.w.T. - von Werner am 18.09.2019 12:48:35
- AW: Lässt sich nicht öffnen. o.w.T. - von Aigo am 18.09.2019 13:11:37
- AW: Lässt sich nicht öffnen. o.w.T. - von Werner am 18.09.2019 14:34:46
- AW: Lässt sich nicht öffnen. o.w.T. - von Aigo am 18.09.2019 14:40:48
- AW: Lässt sich nicht öffnen. o.w.T. - von Werner am 18.09.2019 14:46:14
Betrifft: VBA Suchen, kopieren, einfügen
von: Aigo
Guten Morgen Zusammen,
ich finde leider nirgends eine Lösung zu meinem Problem und hoff ihr könnt mir helfen. Am liebsten per VBA!
Ich möchte Werte(Artikelnummer) in Spalte "C"(ca.1000 Einträge) in Tabelle1, mit Werten(Artikelnummern)in Spalte "C"(hier sind nicht alle Nummern Vorhanden) in Tabelle2 vergleichen. Wenn die Artikelnummer in beiden Tabellen vorhanden ist, soll die komplette Zeile (A:H) aus Tabelle1 in die Zeile der Tabelle 2 kopiert werden, in der die passende Artikelnummer steht und das soll für jede Zeile abegfragt bzw. kopiert werden.
Zurzeit werden Werte die in beiden Tabellen vorhanden sind, in Tabelle1 Grün markiert, falls das hilft.
Ich hoffe ihr habt eine Lösung für mich :)
Gruß
Aigo
Betrifft: AW: VBA Suchen, kopieren, einfügen
von: 1713631.html
Geschrieben am: 18.09.2019 11:44:30
Hallo,
kommen/können die Artikelnummern in beiden Blättern mehrfach vorkommen?
Lad doch am besten mal eine Beispielmappe hier mit ein paar Beispieldaten hoch. Die Mappe sollte im Aufbau deinem Original entsprechen.
Gruß Werner
Betrifft: AW: VBA Suchen, kopieren, einfügen
von: 1713634.html
Danke für die schnelle Antwort!
Nein, die Nummern können pro Blatt nur einmal vorkommen!
Ich habe eine Beispieldatei hochgeladen.
https://www.herber.de/bbs/user/132089.zip
Gruß
Aigo
Betrifft: Lässt sich nicht öffnen. o.w.T.
von: 1713639.html
Geschrieben am: 18.09.2019 12:48:35
Betrifft: AW: Lässt sich nicht öffnen. o.w.T.
von: 1713642.html
https://www.herber.de/bbs/user/132090.zip
habs nochmal neu hochgeladen!
Betrifft: AW: Lässt sich nicht öffnen. o.w.T.
von: 1713668.html
Geschrieben am: 18.09.2019 14:34:46
Hallo,
teste mal:
Option Explicit
Public Sub Übertrag()
Dim raBereich As Range, raZelle As Range, raFund As Range
Application.EnableEvents = False
With Worksheets("Projektliste")
Set raBereich = .Range("C2:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
For Each raZelle In raBereich
If WorksheetFunction.CountIf(Worksheets("Übergabeliste_Inventor").Columns(3), raZelle) > _
0 Then
Set raFund = Worksheets("Übergabeliste_Inventor").Columns(3).Find(what:=raZelle, _
LookIn:=xlValues, _
lookat:=xlWhole)
If Not raFund Is Nothing Then
With Worksheets("Übergabeliste_Inventor")
.Cells(raFund.Row, "A").Resize(, 8).Copy _
raZelle.Offset(, -2)
End With
End If
End If
Next raZelle
End With
Set raBereich = Nothing
End SubGruß Werner
Betrifft: AW: Lässt sich nicht öffnen. o.w.T.
von: 1713670.html
Einwandfrei!!! Funktioniert, vielen dank für die schnelle Hilfe.
Eine Frage hätte ich noch.. Die bedingten Formatierungen werden jetzt bei jeder Zelle mit kopiert. Kann ich das irgendwie ausstellen?
Betrifft: AW: Lässt sich nicht öffnen. o.w.T.
von: 1713672.html
Geschrieben am: 18.09.2019 14:46:14
Hallo,
den Codeteil hier:
With Worksheets("Übergabeliste_Inventor")
.Cells(raFund.Row, "A").Resize(, 8).Copy _
raZelle.Offset(, -2)
End Withersetzen durch:
With Worksheets("Übergabeliste_Inventor")
.Cells(raFund.Row, "A").Resize(, 8).Copy
raZelle.Offset(, -2).PasteSpecial Paste:=xlPasteValues
End WithGruß Werner
