Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1520to1524
1520to1524
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kopieren mit Bedingung

Forumthread: Kopieren mit Bedingung

Kopieren mit Bedingung
08.11.2016 07:06:06
Ludmila
Guten Morgen,
weshalb wird in meiner Datei nicht richtig gefiltert bzw. übertragen.
Danke!
Gruß
Ludmila
https://www.herber.de/bbs/user/109263.xlsm
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Kopieren mit Bedingung
08.11.2016 07:21:39
baschti007
Hey Ludmila
Versuch es mal so
Sub kopieren()
Dim ii As Long
Dim loEnde As Long
Dim wksDaten As Object
Dim wksDruck As Object
Set wksDaten = Sheets("Daten")
Set wksDruck = Sheets("Druck")
With wksDruck
For ii = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
Range(.Cells(ii, 1), .Cells(ii, 6)).ClearContents
Next ii
End With
ii = 2
loEnde = 1
With wksDaten
Do Until IsEmpty(.Cells(ii, 1))
If (.Cells(ii, 1).Value = .Cells(1, 8) And .Cells(ii, 3).Value = .Cells(2, 8)) Then
loEnde = loEnde + 1
With wksDruck.Cells(loEnde, 1).Resize(1, 6)
.Value = wksDaten.Cells(ii, 1).Resize(1, 6).Value
End With
End If
ii = ii + 1
Loop
End With
wksDruck.Select
End Sub
Gruß Basti
Anzeige
AW: Kopieren mit Bedingung
09.11.2016 08:21:24
Ludmila
Hallo Basti,
vielen Dank, es funktioniert.
Gruß
Ludmila

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige