Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

eine Zelle in mehrere Zellen kopieren

eine Zelle in mehrere Zellen kopieren
01.08.2014 13:21:02
Max
Hallo ihr Lieben,
ich habe mal wieder ein Problem...
und zwar möchte ich aus einer Externen Datei eine Zelle herauskopieren
und diese dann in mehrere Zellen in einer neuen Datei reinkopieren.
Mein Problem besteht darin, dass ich die Zelle nur in eine Zelle in der neuen Datei einfügen kann aber nicht in mehrere, denn ich möchte den anderen Daten die ich auch aus der externen Datei entnehme, ein Datum zuordnen.
Ich kopiere also zum Beispiel aus Datei A aus Spalte B 20 Datensätze, die in der Datei B in Spalte A eingefügt werden. Dies funktioniert auch wunderbar.
Jetzt gitb es in Datei A eine Zelle in der das aktuelle Datum steht und dann soll das Makro in Datei B in Spalte B, also neben die eingefügten 20 Daten, das Datum jeweils reinkopieren.
Wäre Super wenn mir jemand einen Tipp geben könnte.
Mein Code sieht bisher wie folgt aus
Sub InterneEinfügen()
Dim varSourceFile As Variant
Dim lngZeile, lngSpalte As Long
Dim endZeile As Long
Dim Quelle As Object, Ziel As Object
varSourceFile = Application.GetOpenFilename("Excel-Dateien (*.xl*), *.xl", 1, "Quelldatei_auswä _
hlen...")
'Abbrechen, falls keine Datei ausgewählt
If varSourceFile = False Then Exit Sub
'Quelldatei öffnen
Workbooks.Open Filename:=varSourceFile
'Datei einfügen
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(1)
'kopieren und einfügen
'Letzte gefüllte Zeile in Spalte A
lngZeile = Ziel.Cells(Rows.Count, 1).End(xlUp).Row + 1
Quelle.Range("B6:B100,F6:F100,D6:D100").Copy Ziel.Cells(lngZeile, 1)
endZeile = Ziel.Cells(Rows.Count, 1).End(xlUp).Row
Do Quelle.Cells(4, 13).Copy Ziel.Cells(lngZeile, 4) until endZeile = true
ActiveWorkbook.Close
'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing
Exit Sub
End Sub
Liebe Grüße
Max

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: eine Zelle in mehrere Zellen kopieren
01.08.2014 13:41:52
Robert
Hallo Max.
Du kannst eine Ganze Range in einer Aktion mit einem Wert füllen.
z.B. Range(Cells(1,1), Cells(10,1)) = Now
Schreibt in Spalte A in den Zeilen 1-10 jeweils das aktuelle Datum
Statt Now dann eben Quelle.Cells(4,13)
Viele Grüße
Robert

AW: eine Zelle in mehrere Zellen kopieren
01.08.2014 13:57:00
Max
Hallo Robert danke für deine schnelle Antwort.
Ich habe jetzt versucht deinen Vorschlag umzusetzen aber irgendwie klappt es nicht so recht....
Kannst du vllt mal schauen was falsch sein könnte ?
Sub InterneEinfügen()
Dim varSourceFile As Variant
Dim lngZeile, lngSpalte As Long
Dim endZeile As Long
Dim Quelle As Object, Ziel As Object
varSourceFile = Application.GetOpenFilename("Excel-Dateien (*.xl*), *.xl", 1, "Quelldatei_auswä _
hlen...")
'Abbrechen, falls keine Datei ausgewählt
If varSourceFile = False Then Exit Sub
'Quelldatei öffnen
Workbooks.Open Filename:=varSourceFile
'Datei einfügen
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(1)
'kopieren und einfügen
'Letzte gefüllte Zeile in Spalte A
lngZeile = Ziel.Cells(Rows.Count, 1).End(xlUp).Row + 1
Quelle.Range("B6:B100,F6:F100,D6:D100").Copy Ziel.Cells(lngZeile, 1)
endZeile = Ziel.Cells(Rows.Count, 1).End(xlUp).Row
Quelle.Cells(4, 13).Copy Ziel.Range(Cells(lngZeile, 4), Cells(endZeile, 4))
ActiveWorkbook.Close
'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing
Exit Sub
End Sub

Anzeige
AW: eine Zelle in mehrere Zellen kopieren
01.08.2014 14:19:06
Robert
Hallo Max,
Warum arbeitest du immernoch mit Copy?
Ziel.Range(Cells(lngZeile, 4), Cells(endZeile, 4)) = Quelle.Cells(4, 13)
Viele Grüße
Robert

AW: eine Zelle in mehrere Zellen kopieren
01.08.2014 14:24:30
Robert
Möööööp.
Hab den Fehler:
Ziel.Range(Ziel.Cells(lngZeile, 4), Ziel.Cells(endZeile, 4)) = Quelle.Cells(4, 13)

AW: eine Zelle in mehrere Zellen kopieren
01.08.2014 14:32:57
Max
Hallo Robert
Habe es jetzt so gemacht, wie du es mir gesagt hast aber er gibt mir dann folgenden Fehler:
Laufzeitfehler 1004
Anwendungs- oder objektdefinierter Fehler
Hier noch einmal der Code vllt findest du den Fehler, den ich dieses Mal gemacht habe
Sub InterneEinfügen()
Dim varSourceFile As Variant
Dim lngZeile, lngSpalte As Long
Dim endZeile, endSpalte As Long
Dim Quelle As Object, Ziel As Object
varSourceFile = Application.GetOpenFilename("Excel-Dateien (*.xl*), *.xl", 1, "Quelldatei_auswä _
hlen...")
'Abbrechen, falls keine Datei ausgewählt
If varSourceFile = False Then Exit Sub
'Quelldatei öffnen
Workbooks.Open Filename:=varSourceFile
'Datei einfügen
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(1)
'kopieren und einfügen
'Letzte gefüllte Zeile in Spalte A
lngZeile = Ziel.Cells(Rows.Count, 1).End(xlUp).Row + 1
Quelle.Range("B6:B100,F6:F100,D6:D100").Copy Ziel.Cells(lngZeile, 1)
endZeile = Ziel.Cells(Rows.Count, 1).End(xlUp).Row
Ziel.Range(Cells(lngZeile, 4), Cells(endZeile, 4)) = Quelle.Cells(4, 13)
'For Each cell In Range(Cells(lngZeile, 4), Cells(endZeile, 4))
'With Quelle.Cells(4, 13)
'End With
'Next
'Quelle.Cells(4, 13).Copy Ziel.Range(Cells(lngZeile, 4), Cells(endZeile, 4))
ActiveWorkbook.Close
'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing
Exit Sub
End Sub
P.S. Ich habe meine alten Ansätze auch noch drinnen aber mit dem ' für den Computer herausgenommen!
Also bitte nicht verwirren lassen.
Grüße
Max

Anzeige
AW: eine Zelle in mehrere Zellen kopieren
01.08.2014 14:36:58
Robert
Hallo Max,
Ich habe mich schon selber korrigiert, siehe Beitrag weiter oben.
Grund für den Fehler:
Wenn man Cells verwendet, bezieht sich das ohne Präfix immer auf Activesheet.
Also musst du statt
Ziel.Range(Cells(lngZeile, 4), Cells(endZeile, 4)) = Quelle.Cells(4, 13)
Das hier Schreiben:
Ziel.Range(Ziel.Cells(lngZeile, 4), Ziel.Cells(endZeile, 4)) = Quelle.Cells(4, 13)

AW: eine Zelle in mehrere Zellen kopieren
01.08.2014 14:42:38
Max
Hallo Robert
Danke für deine Hilfe !
Jetzt funktioniert es!!
Liebe Grüße Max

321 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige