Kopieren mit Bedingung

Forumthread: Kopieren mit Bedingung
2 Beiträge zu diesem Forumthread
Anzeige
VBA Beispiele zu verwandten Themen

Forumthread: Kopieren mit Bedingung

08.11.2016 08: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

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Kopieren mit Bedingung

08.11.2016 08:21:39

baschti007
AW: Kopieren mit Bedingung

09.11.2016 09:21:24

Ludmila

AW: Kopieren mit Bedingung

08.11.2016 08: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

AW: Kopieren mit Bedingung

09.11.2016 09:21:24

Ludmila

Hallo Basti,
vielen Dank, es funktioniert.
Gruß
Ludmila