Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
548to552
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
548to552
548to552
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Suchen, Kopieren und Löschen über VBA

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
Anzeige
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 
Anzeige
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

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige