Live-Forum - Die aktuellen Beiträge
Datum
Titel
15.04.2024 23:32:21
Darstellung im IMAGE sehr schlecht
15.04.2024 21:08:34
PDF mit Makro erstellen mehrere Sheets
15.04.2024 18:38:39
Arbeitszeiten Vorlage ergänzen
15.04.2024 17:34:30
Fehlende Zeilen automatisch nach Zeiten ergänzen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1520to1524
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1520to1524
1520to1524
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kopieren mit Bedingung

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)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige