Suchen, Kopieren und Löschen über VBA

Forumthread: Suchen, Kopieren und Löschen über VBA

19.01.2005 16:29:11

Torsten

Hallo beisammen,
folgendes Problem:
In meiner Datei habe ich ein WS("Liste"), in dessen Range("A3:variabel") einzelne Produktnummern stehen. In einem weiteren WS("DatenLJ") sind die Daten zu allen PN abgelegt:
WS("DatenLJ").Range("C3:variabel") = Produktnummern
WS("DatenLJ").Range("E3:variabel") = Menge
WS("DatenLJ").Range("F3:variabel") = Umsatz
WS("DatenLJ").Range("G3:variabel") = Wareneinsatz
Nun möchte ich, daß Excel über VBA folgendes ausführt:
Excel soll die Liste WS("LISTE") durchgehen und wenn eine PN im WS("DatenLJ") gefunden wurde, sollen die entsprechenden Werte aus Spalte E-G kopiert und in die Spalten I,J und K eingefügt werden und dann die Werte aus E-G gelöscht werden (Clearcontents).
Da die Anzahl der Daten in dem WS("DatenLJ") gegen 32.500 tendiert, wäre ich sehr dankbar, wenn Ihr mir hier weiterhelfen könntet. Meine eigenen VBA-Kenntnisse reichen hierzu leider nicht aus.
Vielen Dank im voraus.
Gruß
Torsten

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suchen, Kopieren und Löschen über VBA

19.01.2005 16:45:26

Josef
AW: erledigt - mT

Torsten

AW: Suchen, Kopieren und Löschen über VBA

19.01.2005 16:45:26

Josef

Hallo Thorsten!
Probier mal:

Sub verschiebeDaten()
Dim wksList As Worksheet
Dim wksData As Worksheet
Dim rng As Range, rFind As Range
Dim lastRow As Long
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Set wksList = Sheets("Liste")
Set wksData = Sheets("DatenLJ")
lastRow = IIf(wksList.Range("A65536") <> "", 65536, _
   wksList.Range("A65536").End(xlUp).Row)

   For Each rng In wksList.Range("A3:A" & lastRow)
      If rng <> "" Then
      Set rFind = wksData.Range("C:C").Find(rng)
         If Not rFind Is Nothing Then
            With wksData
            .Range(.Cells(rFind.Row, 9), .Cells(rFind.Row, 11)).Value = _
            .Range(.Cells(rFind.Row, 5), .Cells(rFind.Row, 7)).Value
            .Range(.Cells(rFind.Row, 5), .Cells(rFind.Row, 7)).ClearContents
            End With
         End If
      End If
   Next

ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

AW: erledigt - mT

Torsten

Hallo Sepp,
vielen Dank für Deine rasche Rückmeldung.
Dein Code läuft wunderbar durch. Genau das, was ich brauchte. :-))
Nochmals schönen Dank und
Gruß
Torsten

Beliebteste Forumthreads (12 Monate)

Suchen, Kopieren und Löschen über VBA

Forumthread: Suchen, Kopieren und Löschen über VBA

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread