Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1316to1320
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
Inhaltsverzeichnis

Kopieren mit Bedingung

Kopieren mit Bedingung
15.06.2013 10:09:17
Beate
Hallo Forum, hallo Experten,
Ich versuche mich immer noch an der Lösung meines Problems.
Folgendes kann ich nicht umsetzen:
Aus einem von 31 müssen bestimmte Daten, stehen in Spalte c und e, in ein gesondertes Blatt mit dem Namen "Aushang".
Allerdings sind es a) unterschiedliche Bereiche. Der obere Bereich c5:e14 kann einfach kopiert werden. Der untere Bereich c20:d29, soll wenn was drinnen steht, mit Überschrift aus einer Hilfsspalte, x5, kopiert werden.
Das kopieren ohne diese blöde aber unbedingt notwendige Überschrift klappt. Nur die Überschrift...
Hab es etwas umgestellt und per Formel in Spalte a ein x wenn in den zu kopierenden Spalte c:d Text steht, einfügen lassen. Weiß nicht ob das der richtige weg sein kann?
Bitte liebe Profis, helft mir...ich grübel mir sonst noch einen Wolf.
Danke und schönes Wochenende

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopieren mit Bedingung
15.06.2013 10:49:10
fcs
Hallo Beate,
man kann prüfen, ob alle Zellen in einem Zellbereich leer sind und abhängig vo Ergebnis die Zellen kopieren.
Die Überschrift in X5 wird einfach in einem 2. Schritt in die gewünschte Zelle im Aushang kopiert.
Gruß
Franz
Sub CopyToAnhang()
Dim wks As Worksheet, wksAushang As Worksheet
Set wks = ActiveSheet
Set wksAushang = ActiveWorkbook.Worksheets("Aushang")
wks.Range("C5:E14").Copy wksAushang.Range("C5")
With wks.Range("C20:D29")
If Application.WorksheetFunction.CountBlank(.Cells) = .Cells.Count Then
'MsgBox "Alle Zellen ""C20:D29"" sind leer"
'Zellen im Aushang leeren
With wksAushang
.Range("C19").ClearContents 'Überschrift-Zelle
.Range("C20:D29").ClearContents 'Datenbereich
End With
Else
'MsgBox "Mindestens eine Zelle in ""C20:D29"" ist ausgefüllt"
wks.Range("X5").Copy wksAushang.Range("C19") 'Überschrift kopieren
.Copy wksAushang.Range("C20") 'Datenzellen kopieren
End If
End With
wksAushang.Activate
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige