Formatierung geht beim kopieren und wandeln verloren

Question

Hallo,
wer kann mir helfen?
Ich habe ein Kalkulationsformular(Tabelle1) aus dem bestimmte Daten kopiert und auf diesen Blatt gesammelt werden. (Formatierung??)Diese Daten werden im Block in eine ander Mappe(Datensammlung) kopiert.(Formatierung??)
Bei den Formaten handelt es sich um Text,Zahl ohne Komma, Zahl mit Komma und Benutzerdefiniert "t="0,00"mm"
Die Formatierung ist wichtg da die Datensammlung in eine Text-Datei gewandelt wird, um die Daten in ein anders Programm zu importieren.
Ich glaube Value ist der springente Punkt.
schon mal Danke
Gruß
Ulle

Sub TESTGIVspeichern()


Dim verz, dname As String
verz = Cells(5, 7)
dname = Cells(6, 3) & ".xls"
'Achtung richtiges Laufwerk eintragen!!
'ActiveWorkbook.SaveAs Filename:=("G:\" & verz & "\" & dname) ', FileFormat:=xlNormal
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.SaveAs Filename:=("C:\" & verz & "\" & dname) ', FileFormat:=xlNormal

Application.ScreenUpdating = False

Range("B200").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("C6").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("C5").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("G5").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 1) = ActiveSheet.Range("C10").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 2) = ActiveSheet.Range("E10").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 3) = ActiveSheet.Range("C42").Value

ActiveSheet.Range("B30:B40").Copy
Range("b200").End(xlUp).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 4).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("b200").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("E60").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("B58").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = "."
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("Q128").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("Q129").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("Q130").Value
Cells(ActiveCell.Row + 4, ActiveCell.Column + 0) = ActiveSheet.Range("Q131").Value
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("Q132").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("Q133").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("Q134").Value
Cells(ActiveCell.Row + 4, ActiveCell.Column + 0) = ActiveSheet.Range("Q135").Value
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("Q136").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("Q137").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("Q138").Value
Cells(ActiveCell.Row + 4, ActiveCell.Column + 0) = ActiveSheet.Range("Q139").Value
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("Q140").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("Q141").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("Q142").Value
Cells(ActiveCell.Row + 4, ActiveCell.Column + 0) = ActiveSheet.Range("Q143").Value
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("Q144").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("Q145").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("Q146").Value
Cells(ActiveCell.Row + 4, ActiveCell.Column + 0) = ActiveSheet.Range("Q147").Value
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("Q148").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("Q149").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("Q150").Value
Cells(ActiveCell.Row + 4, ActiveCell.Column + 0) = ActiveSheet.Range("Q151").Value
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("Q152").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("Q153").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("Q154").Value
Cells(ActiveCell.Row + 4, ActiveCell.Column + 0) = ActiveSheet.Range("Q155").Value
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("Q156").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("Q157").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("Q158").Value
Cells(ActiveCell.Row + 4, ActiveCell.Column + 0) = ActiveSheet.Range("Q159").Value
Range("B65536").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("Q160").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("Q161").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("Q162").Value
Cells(ActiveCell.Row + 4, ActiveCell.Column + 0) = ActiveSheet.Range("Q163").Value

ActiveSheet.Range("B128:P169").Copy
Windows("Datensammlung.xls").Activate
Range("A65536").End(xlUp).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 0).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A65536").End(xlUp).Select

Application.CutCopyMode = False
Range("a65536").End(xlUp).Select

Windows(dname).Activate

ActiveSheet.Range("B128:P169").Select
Selection.ClearContents
Application.CutCopyMode = False

Range("C5").Select



End Sub

Answer 1

Hallo Ulle,

ich glaube nicht, dass es an .Value liegt, sondern eher daran, wie Du Deine kopierten Daten einfügst. Du fügst die Daten mit

Paste:=xlValues
ein. Das bedeutet, Du fügst nur die Werte ohne Formatierungen ein. Wenn Du auch die Formate mitnehmen möchstest, dann musst Du z.B.

Paste:=xlPasteAll
nehmen. Das fügt alles, auch die Formate mit ein. Probiers einfach mal aus.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 2

Hallo Oliver,
es funktioniert nicht.
Ich möchte nur den formatierten Zelleninhalt kopieren,
nicht Rahmen und Farbe.

Paste:=xlPasteAll
ist der Befehl für verbundene Zellen und wie heißt er bei einzelnen Zellen?

Gruß
Ulle

Answer 3

Hallo Ulle,

Du solltest Dich mal mit grundlegenden Eigenschaften des Befehls ".copy" bekannt machen. Eine Hilfe dazu wäre den Cursor in das Wort "copy" zu stellen und dann die F1-Taste zu betätigen. Die Eigenschaft "xlPasteAll" hat nichts mit verbundenen Zellen zu tun, sondern gibt an, dass alles, also auch Formate der Zellen mit einfügt werden sollen. Wenn Du Rahmen und Hintergrundfarbe nicht haben möchtest, dann musst Du diese per VBA-Befehl wieder löschen. Das geht z.B. so:

With Range("B30:B40")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Interior.Pattern = xlNone
End With
Andere Alternative wäre, Du beläst Deinen VBA-Code wie er ist und setzt dann abschließend die Formate für die Zellen. Um die VBA-Befehle zu erhalten nutze den VBA-Makrorekorder. Der zeichnet Dir alle Befehle auf, die Du dann nur am Ende in Deinen VBA-Code einpflegen musst.

Solltest Du nicht wissen, wie Du den Makrorekorder benutzt, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 7 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

Bei Fragen melde Dich.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 4

Hallo Oliver,
Ich habe noch nicht alles durchprobiert.
nur noch mal zur Erklärung.
Ich bin absoluter Leihe auf dem Gebiet, daß ist eigentlich mein erstes Makro.
So, die Daten auf dem Tabellenblatt zu sammeln erschien mir als die einfachere Variante, da ich da die Zielzellen noch Formatieren kann. (Die Zielzellen sind immer die gleichen und werden immer wieder geleert.)

Range("B200").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("C6").Value
Cells(ActiveCell.Row + 2, ActiveCell.Column + 0) = ActiveSheet.Range("C5").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 0) = ActiveSheet.Range("G5").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 1) = ActiveSheet.Range("C10").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 2) = ActiveSheet.Range("E10").Value
Cells(ActiveCell.Row + 3, ActiveCell.Column + 3) = ActiveSheet.Range("C42").Value

ActiveSheet.Range("B30:B40").Copy
Range("b200").End(xlUp).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 4).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
U.S.W.

Jetzt wird der Datenblock geschlossen in eine andere Mappe kopiert und an den letzten Datenblock angehängt.
Eine Formatierung der Zellen ist nicht möglich, belegte Zellen sind nicht eindeutig.

ActiveSheet.Range("B128:P169").Copy
Windows("Datensammlung.xls").Activate
Range("A65536").End(xlUp).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 0).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A65536").End(xlUp).Select

Application.CutCopyMode = False

Bei erste Schritt ist die Formatierung O.K.
beim zweiten Schritt geht sie verloren!!
Hier wäre der Hintergrund (Farbe und Rahmen) kein Problem mehr, ist nicht mehr vorhanden!
Vieleicht macht die Erklärung mein Problem begreiflicher
Gruß
Ulle