Microsoft Excel

Herbers Excel/VBA-Archiv

eine Zelle in mehrere Zellen kopieren

Betrifft: eine Zelle in mehrere Zellen kopieren von: Max
Geschrieben am: 01.08.2014 13:21:02

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

  

Betrifft: AW: eine Zelle in mehrere Zellen kopieren von: Robert
Geschrieben am: 01.08.2014 13:41:52

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


  

Betrifft: AW: eine Zelle in mehrere Zellen kopieren von: Max
Geschrieben am: 01.08.2014 13:57:00

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



  

Betrifft: AW: eine Zelle in mehrere Zellen kopieren von: Robert
Geschrieben am: 01.08.2014 14:19:06

Hallo Max,

Warum arbeitest du immernoch mit Copy?

Ziel.Range(Cells(lngZeile, 4), Cells(endZeile, 4)) = Quelle.Cells(4, 13)

Viele Grüße
Robert


  

Betrifft: AW: eine Zelle in mehrere Zellen kopieren von: Robert
Geschrieben am: 01.08.2014 14:24:30

Möööööp.

Hab den Fehler:

Ziel.Range(Ziel.Cells(lngZeile, 4), Ziel.Cells(endZeile, 4)) = Quelle.Cells(4, 13)


  

Betrifft: AW: eine Zelle in mehrere Zellen kopieren von: Max
Geschrieben am: 01.08.2014 14:32:57

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


  

Betrifft: AW: eine Zelle in mehrere Zellen kopieren von: Robert
Geschrieben am: 01.08.2014 14:36:58

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)


  

Betrifft: AW: eine Zelle in mehrere Zellen kopieren von: Max
Geschrieben am: 01.08.2014 14:42:38

Hallo Robert

Danke für deine Hilfe !
Jetzt funktioniert es!!

Liebe Grüße Max


 

Beiträge aus den Excel-Beispielen zum Thema "eine Zelle in mehrere Zellen kopieren"