Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
352to356
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
352to356
352to356
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten uebertragen

Daten uebertragen
22.12.2003 09:03:23
Alexej
Guten Morgen Forum :)

Wie kann ich es bewerkstelligen, dass ich sage:

Ich habe ein Arbeitsbuch X, dort ein Arbeitsblatt X1. Nun sollen alle Daten, die sich auf diesem Arbeitsblatt befinden und in gelben Zellen stehen (Index der Farbe = 36) in die selben Zellen kopiert werden, in das Arbeitsbuch Y, Arbeitsblatt Y1.

Danke vielmals und Gruesse,
Alexej

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten uebertragen
22.12.2003 09:37:44
Josef Ehrensberger
Hallo Alexej,

probier mal diesen Code.



Sub KopierenNachFarbe()
'Beide Arbeitsmappen sind geöffnet
Dim wbkQuelle As Workbook
Dim wbkZiel As Workbook
Dim rng As Range
Set wbkQuelle = Workbooks("Quelldatei.xls")                 'Name anpassen
Set wbkZiel = Workbooks("Zieldatei.xls")                    'Name anpassen
For Each rng In wbkQuelle.Sheets("X1").Range("A1:I30")      'Name und Bereich anpassen
    If rng.Interior.ColorIndex = 36 Then
    wbkZiel.Sheets("Y1").Range(rng.Address) = rng.Value     'Name anpassen
    End If
Next
End Sub


     Code eingefügt mit Syntaxhighlighter 2.5


Gruß Sepp
Anzeige
Danke sehr :)) o.T.
22.12.2003 09:45:44
Alexej
AW: Daten uebertragen
22.12.2003 09:41:26
WernerB.
Hallo Alexej,

wie gefällt Dir das?

Sub Alexej()
Dim wsQ As Worksheet, wsZ As Worksheet
Dim c As Range
Dim Aru As String
Set wsQ = ThisWorkbook.Worksheets("X1")
Set wsZ = Workbooks("Y.xls").Worksheets("Y1")
With wsQ
Aru = .Cells(.Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row, _
.Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column).Address
For Each c In .Range("A1:" & Aru)
If c.Interior.ColorIndex = 36 Then
wsZ.Range(c.Address).Value = c.Value
End If
Next c
End With
Set wsQ = Nothing
Set wsZ = Nothing
End Sub

Viel Erfolg, frohes Fest und guten Rutsch wünscht
WernerB.

P.S.: Das Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter (siehe Forums-FAQ).
Anzeige
Danke dir Werner :) o.T.
22.12.2003 09:47:02
Alexej

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige