Herbers Excel/VBA-Archiv

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
Geschrieben am: 18.09.2019 11:13:08

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
Geschrieben am: 18.09.2019 12:16:25

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
Geschrieben am: 18.09.2019 13:11:37

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 Sub

Gruß Werner

Betrifft: AW: Lässt sich nicht öffnen. o.w.T. von: 1713670.html
Geschrieben am: 18.09.2019 14:40:48

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 With

ersetzen durch:

With Worksheets("Übergabeliste_Inventor")
    .Cells(raFund.Row, "A").Resize(, 8).Copy
    raZelle.Offset(, -2).PasteSpecial Paste:=xlPasteValues
End With

Und ganz am Ende, vor End Sub noch Application.CutCopyMode = False einsetzen.

Gruß Werner

Beiträge aus dem Excel-Forum zum Thema "VBA Suchen, kopieren, einfügen"