Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1476to1480
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

ormatierungen beim Kopieren in ein anderes Excel m

ormatierungen beim Kopieren in ein anderes Excel m
25.02.2016 19:36:29
jojue
Hallo Forum-User
Dank super Unterstützung gelang es mir, Werte von einem Exceldokument in ein andere kopieren zu lassen.
Nun möchte ich auch noch die Formatierungen von Masterdokument zum zweiten Dokument mit kopieren.
Das heisst, ich hab im ersten Dokument Spalten mit Datumswerten, Zweitwerten, Zahlenwerte, Textwerte etc.
Nun möchte ich, dass diese Formatierungen im Exceldokument, in welches die Werte kopierte werden ebenfalls übernommen werden.
Kann mir da jemand helfen?
Das kopieren von einem Dokument in das andere wurde so gelöst:
Sub NachDruckversion()
'aktive Mappe = Auffang.xlsm
Dim arrCH() As Variant              'Datenfeld1
Dim arrRT() As Variant              'Datenfeld2
Dim rngZiel As Range                'Zielzelle
Dim rngQuelle As Range              'zu verschiebende Daten
Dim lngLast As Long                 'jew. letzte Zeile
'nur aktive Mappe = Auffang.xlsm
If Workbooks.Count > 1 Then Exit Sub
'Seiten gefüllt, sonst Abbruch
With Sheets("Zweiteseite")
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With
With Sheets("Dritteseite")
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With
On Error GoTo eHandler
Application.ScreenUpdating = False
Workbooks.Open Filename:=ThisWorkbook.Path & "\Druckversion.xlsm"
'Mappe = Druckversion.xlsm - leeren
With Workbooks(2)
With .Sheets("Zweite")
.Cells.Clear
End With
With .Sheets("Dritte")
.Cells.Clear
End With
End With
'Daten aufnehmen
With Workbooks(1)
'je Tabelle
With .Sheets("Zweiteseite")
'benutzer Bereich
lngLast = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
With .Columns("C:H")
Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
'in Datenfeld
arrCH = rngQuelle.Value
End With
'ditto
With .Columns("P:T")
Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
arrRT = rngQuelle.Value
End With
End With
'ins Ziel schreiben
Set rngZiel = Workbooks(2).Sheets("Zweite").Range("A1")
rngZiel.Resize(UBound(arrCH, 1), UBound(arrCH, 2)).Value = arrCH
'ditto
Set rngZiel = Workbooks(2).Sheets("Zweite").Range("G1")
rngZiel.Resize(UBound(arrRT, 1), UBound(arrRT, 2)).Value = arrRT
'wie vor, andere Tabelle
With .Sheets("Dritteseite")
lngLast = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
With .Columns("C:H")
Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
arrCH = rngQuelle.Value
End With
With .Columns("P:T")
Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
arrRT = rngQuelle.Value
End With
End With
Set rngZiel = Workbooks(2).Sheets("Dritte").Range("A1")
rngZiel.Resize(UBound(arrCH, 1), UBound(arrCH, 2)).Value = arrCH
Set rngZiel = Workbooks(2).Sheets("Dritte").Range("G1")
rngZiel.Resize(UBound(arrRT, 1), UBound(arrRT, 2)).Value = arrRT
End With
'speichern, schließen
Workbooks(2).Close True
eHandler:
Select Case Err.Number
Case 0   'erfolgreich
Case Else
MsgBox "Fehler bei der Ausführung"
End Select
Application.ScreenUpdating = True
End Sub

Besten Dank und Gruss
JoGiLU

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

Betreff
Datum
Anwender
Anzeige
AW: ormatierungen beim Kopieren in ein anderes Excel m
26.02.2016 11:56:00
fcs
Hallo Jojue,
probier es mal so.
Quell- und Zielmappe werden über Variablen verwaltet.
Gruß
Franz

Sub NachDruckversion()
'aktive Mappe = Auffang.xlsm
Dim arrCH() As Variant              'Datenfeld1
Dim arrRT() As Variant              'Datenfeld2
Dim rngZiel As Range                'Zielzelle
Dim rngQuelle As Range              'zu verschiebende Daten
Dim lngLast As Long                 'jew. letzte Zeile
Dim wkbQuelle As Workbook
Dim wkbZiel As Workbook
'nur aktive Mappe = Auffang.xlsm
'  If Workbooks.Count > 1 Then Exit Sub
Set wkbQuelle = Application.Workbooks("Auffang.xlsm")
With wkbQuelle
'Seiten gefüllt, sonst Abbruch
With .Sheets("Zweiteseite")
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With
With .Sheets("Dritteseite")
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With
End With
On Error GoTo eHandler
Application.ScreenUpdating = False
Set wkbZiel = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Druckversion.xlsm")
'Mappe = Druckversion.xlsm - leeren
With wkbZiel
With .Sheets("Zweite")
.Cells.Clear
End With
With .Sheets("Dritte")
.Cells.Clear
End With
End With
'Daten aufnehmen
With wkbQuelle
'je Tabelle
With .Sheets("Zweiteseite")
'benutzer Bereich
lngLast = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
With .Columns("C:H")
Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
'in Datenfeld
arrCH = rngQuelle.Value
rngQuelle.Copy
wkbZiel.Sheets("Zweite").Range("A1").PasteSpecial xlPasteFormats
End With
'ditto
With .Columns("P:T")
Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
arrRT = rngQuelle.Value
rngQuelle.Copy
wkbZiel.Sheets("Zweite").Range("G1").PasteSpecial xlPasteFormats
End With
End With
'ins Ziel schreiben
Set rngZiel = wkbZiel.Sheets("Zweite").Range("A1")
rngZiel.Resize(UBound(arrCH, 1), UBound(arrCH, 2)).Value = arrCH
'ditto
Set rngZiel = wkbZiel.Sheets("Zweite").Range("G1")
rngZiel.Resize(UBound(arrRT, 1), UBound(arrRT, 2)).Value = arrRT
'wie vor, andere Tabelle
With .Sheets("Dritteseite")
lngLast = .Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
With .Columns("C:H")
Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
arrCH = rngQuelle.Value
rngQuelle.Copy
wkbZiel.Sheets("Dritte").Range("A1").PasteSpecial xlPasteFormats
End With
With .Columns("P:T")
Set rngQuelle = Range(.Rows(1), .Rows(lngLast))
arrRT = rngQuelle.Value
rngQuelle.Copy
wkbZiel.Sheets("Dritte").Range("G1").PasteSpecial xlPasteFormats
End With
End With
Set rngZiel = wkbZiel.Sheets("Dritte").Range("A1")
rngZiel.Resize(UBound(arrCH, 1), UBound(arrCH, 2)).Value = arrCH
Set rngZiel = wkbZiel.Sheets("Dritte").Range("G1")
rngZiel.Resize(UBound(arrRT, 1), UBound(arrRT, 2)).Value = arrRT
End With
'speichern, schließen
wkbZiel.Close True
eHandler:
Select Case Err.Number
Case 0   'erfolgreich
Case Else
MsgBox "Fehler bei der Ausführung"
End Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Anzeige
AW: ormatierungen beim Kopieren in ein anderes Excel m
26.02.2016 12:09:19
Michael
Hi JoGiLU,
versuch's mal so:
Option Explicit
Sub NachDruckversion()
'aktive Mappe = Auffang.xlsm
Dim wbQ As Workbook, wbZ As Workbook
Dim arrCH() As Variant              'Datenfeld1
Dim arrRT() As Variant              'Datenfeld2
Dim rngZiel As Range                'Zielzelle
Dim rngQuelle As Range              'zu verschiebende Daten
Dim lngLast As Long                 'jew. letzte Zeile
'nur aktive Mappe = Auffang.xlsm
If Workbooks.Count > 1 Then Exit Sub
'Seiten gefüllt, sonst Abbruch
With Sheets("Zweiteseite")
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With
With Sheets("Dritteseite")
If Application.WorksheetFunction.CountA(.Cells) = 0 Then Exit Sub
End With
On Error GoTo eHandler
Application.ScreenUpdating = False
Set wbQ = ActiveWorkbook
Workbooks.Open Filename:=ThisWorkbook.Path & "\Druckversion.xlsm"
Set wbZ = ActiveWorkbook
'Mappe = Druckversion.xlsm - leeren
wbZ.Sheets("Zweite").Cells.Clear
wbZ.Sheets("Dritte").Cells.Clear
'Daten aufnehmen
lngLast = wbQ.Sheets("Zweiteseite").Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
wbQ.Sheets("Zweiteseite").Range("C1:H" & lngLast).Copy wbZ.Sheets("Zweite").Range("A1")
wbQ.Sheets("Zweiteseite").Range("P1:T" & lngLast).Copy wbZ.Sheets("Zweite").Range("G1")
lngLast = wbQ.Sheets("Dritteseite").Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
wbQ.Sheets("Dritteseite").Range("C1:H" & lngLast).Copy wbZ.Sheets("Dritte").Range("A1")
wbQ.Sheets("Dritteseite").Range("P1:T" & lngLast).Copy wbZ.Sheets("Dritte").Range("G1")
'speichern, schließen
wbZ.Close True
eHandler:
Select Case Err.Number
Case 0   'erfolgreich
Case Else
MsgBox "Fehler bei der Ausführung"
End Select
Application.ScreenUpdating = True
End Sub
Arrays sind zwar eine schöne Sache, aber wenn man einen schlichten Bereich kopieren will, ist range.copy viel schöner zu schreiben und sicher nicht spürbar langsamer.
Schöne Grüße,
Michael

Anzeige
AW: geklappt DANKE
27.02.2016 12:40:07
jojue
Hallo Franz
Hallo Michael
Besten Dank für eure Unterstützung.
Beide funktionieren - SUPER
Habe nun die Version von Michael eingesetzt.
Beste Grüsse und DANKE
jojue

freut mich, danke für die Rückmeldung owT
27.02.2016 16:07:58
Michael

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige