Makro: Suchen Auschneiden einfügen

Also ich habe mich jetzt mal etwas schlau gemacht, bin neu hier im Forum und muss mich da erstmal durchmoggeln. Ich habe versuch in einem anderen thread ne Frage zu hinterlassen hat leider nicht geklappt. Also muss ich nochmal neu eröffnen. Sorry.
Ich habe 2 Tabellen, in der Tabelle A ist eine Datenbank mit einem Bestand und Beschreibungen der Artikel. In der Tabelle 2, diese befindet sich in einer anderen Datei, sind die Anzahl der Artikel aufgelistet.
Also Tab1: Nr. | Artikel | Anzahl | Beschreibung
Tab2 : Nr. | Artikel | Anzahl |
Das Makro soll die Nr. aus Tab1 zum suchen benutzen und das Suchergebniss in Tabelle 2 Eintragen. Und anschließen den Wert Löschen in Tab2. Es muss aber mit der Nummer übereinstimmen. Das ganze soll mit ca 80 Artikelnr. durchlaufen und in 80 Zeilen ausgegeben werden. Ich habe es versucht mit einer Einzelnen Zeile und bin soweit gekommen: also ungefähr mit diesem Script:

Sub ZeilenUebertragen()
' Makro am 25.02.2010 von Ing.Grohn aufgezeichnet (Danke von Tobias)
Dim Zeile As Long
Dim Anzahl1 As Long
Dim Anzahl2 As Long
Dim sZeile As String
Sheets("Tabelle1").Activate
I = 1
Anzahl1 = ActiveSheet.UsedRange.Rows.Count
For Zeile = 1 To Anzahl1
Sheets("I:\Tabelle2.xlsx").Activate
If Cells(Zeile, 3).Value = "x" Then     ' "3"  wg. Spalte C
sZeile = LTrim(Str(Zeile))
Rows(sZeile & ":" & sZeile).Select
Selection.Copy
Selection.EntireRow.Delete
Sheets("Tabelle1").Select
Anzahl2 = ActiveSheet.UsedRange.Rows.Count
Range("A" + LTrim(Str(Anzahl2 + 1))).Select
ActiveSheet.Paste
End If
Next Zeile
End Sub

Mit der automatischen Aktualisierung werde ich mich noch dran versuchen. Danke erstmal.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Public Sub ArtSuchenZeileVerschieben() Dim QuellWB, ZielWB As Workbook Dim QuellTab, ZielTab As Worksheet Dim Zellchen As Range Set QuellWB = Workbooks("Bestand 111107.xlsx") Set ZielWB = Workbooks("ArtikelRech.xlsm") Set QuellTab = QuellWB.Worksheets("111107") Set ZielTab = ZielWB.Worksheets("Tabelle2") For Each Zellchen In ZielTab.Range("A2:A" & ZielTab.UsedRange.Rows.Count) Debug.Print Zellchen.Address If Not QuellTab.Range("B2:B" & QuellTab.UsedRange.Rows.Count).Find(QuellTab.Text) Is _ Nothing Then Debug.Print "Gefunden: " & Zellchen.Address & " in " & QuellTab.Range("B2:B" & QuellTab. _ UsedRange.Rows.Count).Find(Zellchen.Text).Address QuellTab.Range("B2:B" & QuellTab.UsedRange.Rows.Count).Find(Zellchen.Text).EntireRow. _ Cut Zellchen.EntireRow End If Next End Sub

Beliebteste Forumthreads (12 Monate)

Makro: Suchen Auschneiden einfügen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread