Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon Ulle-gt5 vom 04.10.2021, 14:51 Options

nach Eingabe formatierten Inhalt kopieren

Hallo ihr freundlichen Helfer,
ich habe mal wieder ein Problem beim kopieren von Zellinhalten.
Nach eingabe in eine Tabelle, werden die Einträge formatiert und sollen jetzt mit Formatierung sortiert und kopiert werden!
(Die Formatierung ist in den Eingabefeldern hinterlegt)
Es ist eine Benutzerdefinierte Formatierung ("N"#),
in allen Zellen wird nur ein Buchstabe vorgesetzt.
schon mal danke
ulle

Sub CNCspeichern()

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

Application.ScreenUpdating = False

'Einträge sortieren-Leerzellen entfernen

Range("K10").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("K5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("L5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("M5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("N5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("O5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("P5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("Q5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("R5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("S5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("T5").Value

'sortierten Block kopieren

ActiveSheet.Range("K6:T6").Copy
Range("A1000").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False 'True

ActiveSheet.Range("K6:T6").Delete
'ActiveSheet.Range("L5:T5").ClearContents

Application.CutCopyMode = False

'Windows(dname).Activate

Range("K5").Select

End Sub

Antwort schreiben

Antwort 1 von coros vom 04.10.2021, 16:51 Options

Hallo ulle,

und was ist jetzt deine Frage? Das Makro funktioniert nicht? Das Makro macht nich dass, was Du möchtest?

Du müsstest schon etwas genauer werden. Eventuell lädst Du auch eine Beispieldatei bei z.B. http://www.file-upload.net/ hoch und postest dann hier den Link, den Du erhältst. Eventuell wird dadruch einiges klarer.

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

Antwort 2 von Ulle-gt5 vom 04.10.2021, 17:01 Options

Sorry Oliver,
wenn mann das Problem hat erkennt mann die Frage.
Beim Kopieren geht die Formatierung verloren oder wird garnicht gesagt das sie mit soll!
gruß Ulle

Antwort 3 von Ulle-gt5 vom 04.10.2021, 17:04 Options

Hallo Oliver,
ich habe die Datei mal hochgeladen!

http://www.file-upload.net/download-1925803/Test2.xls.html

Gruß Ulle

Antwort 4 von malSchauen vom 04.10.2021, 17:14 Options

Hi,

Ich gehe einmal davon aus, dass die Zellen K5 bis T5 Deine formatierten "Eingabe-Zellen" sind. Dann würde das Sortieren und Kopieren bei mir wie folgt aussehen:

Dim lngFirstRow As Long
Dim rngZelle As Range
Dim lngCount As Long
lngFirstRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  For Each rngZelle In Range("K5:T5")
      If rngZelle.Value <> "" Then
        rngZelle.Copy
        Cells(lngFirstRow, 1 + lngCount).PasteSpecial Paste:=xlPasteValues
        Cells(lngFirstRow, 1 + lngCount).PasteSpecial Paste:=xlPasteFormats
        lngCount = lngCount + 1
      End If
  Next
Application.CutCopyMode = False

bye
malSchauen

Antwort 5 von coros vom 04.10.2021, 17:30 Options

Hallo Ulle,

also im Makro in dem Bereich

Range("K10").End(xlUp).Select
Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("K5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("L5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("M5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("N5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("O5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("P5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("Q5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("R5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("S5").Value
Range("T6").End(xlToLeft).Select
Cells(ActiveCell.Row + 0, ActiveCell.Column + 1) = ActiveSheet.Range("T5").Value

kopierst Du nur die Werte, nicht aber die Formate der Zellen. Du dürftest dort nicht mit dem Gleichheitszeichen, also

Cells(ActiveCell.Row + 1, ActiveCell.Column + 0) = ActiveSheet.Range("K5").Value
sondern Du musst auch hier richtig kopieren und einfügen. Also

ActiveSheet.Range("K5").Copy Cells(ActiveCell.Row + 1, ActiveCell.Column + 0).PasteSpecial Paste:=xlPasteAll

Außerdem musst Du dann die Zeile

Cells(ActiveCell.Row + 1, ActiveCell.Column + 0).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
in

Cells(ActiveCell.Row + 1, ActiveCell.Column + 0).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
ändern, also Paste:=xlValues in Paste:=xlPasteAll, damit auch hier die Formate mit eingefügt werden.

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

Antwort 6 von Ulle-gt5 vom 04.10.2021, 17:38 Options

Hallo malSchauen,
deine Lösung ist Super und funktioniert einwandfrei!!!!!!!
So eine kurze Lösung hätte ich nie gefunden.
Es währe schön, den Fehler in meinen Makro für mein VBA-Wissen zu kennen.
Für mein Makro gibts bestimmt eine Ergänzung, die ich verstehe.
trotzdem Danke
Gruß Ulle

Antwort 7 von coros vom 04.10.2021, 17:50 OptionsLösung

Hallo ulle,

das steht in meiner AW5, warum das bei Dir nicht funktioniert hat.

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

Antwort 8 von Ulle-gt5 vom 04.10.2021, 17:51 Options

Halt ich nehme alles zurück.
Oliver, Deine Lösung ist genau sogut und ich verstehe sie auch.
Aber nach Prüfung beider Varianten habe ich festgestellt das auch die Rahmen mit kopiert werden, was nicht so schön ist.
Wie ich euch kenne, habt ihr auch dafür eine Lösung!
Danke Ulle

Antwort 9 von coros vom 04.10.2021, 18:24 Options

Hallo Ulle,

sollte das nicht? Siehe AW2

Zitat:
Beim Kopieren geht die Formatierung verloren oder wird garnicht gesagt das sie mit soll!

Was von welcher Formatierung soll denn nun mit in die neuen Zellen?

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

Antwort 10 von malSchauen vom 04.10.2021, 19:02 Options

Hi,

Wenn es nur um die Werte und Zahlenformate ("N" #) geht,
dann verwende bei der Lösung von Coros aus AW5
eben Paste:=xlPasteValuesAndNumberFormats
anstatt des Paste:=xlPasteAll.

Wunder Dich dann aber nicht, das die Schrift dann nicht
kursiv, bunt oder fett ... ist.

bye
malSchauen

Antwort 11 von coros vom 04.10.2021, 19:30 Options

HaAllo @malSchauen,

deshalb meine Frage in AW9.

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

Antwort 12 von malSchauen vom 04.10.2021, 19:45 Options

Hi,

@Oliver (coros)
Der Grund Deiner Nachfrage in AW9 war mir schon klar. ;-)
Ich schreibe ja auch nur das, was ich mir aus dem hier von
Ulle (Ulle-gt5) geschriebenen Text so zusammenreime.
Dies ist auch der Grund, warum ich in AW4 Werte und Formate
einzeln übertragen habe, statt direkt xlPasteAll zu verwenden.
Nicht, dass er in seinen sog. "Eingabezellen" nun doch Formeln
stehen hat. Und warum nicht gleich xlPasteValuesAndNumberFormats?
Ich hatte das Benutzerdefinierte Formatierung ("N"#) fälschlicherweise
als "Bedingte Formatierung" aufgefasst. Und da hätte dann imo
xlPasteValuesAndNumberFormats nicht gewirkt.

bye
malSchauen

Antwort 13 von Ulle-gt5 vom 04.10.2021, 19:47 Options

Hallo Oliver, Hallo malSchauen,
nochmal Danke, alle euere AW waren Super!
Auch AW10 funktioniert ohne Probleme.
Einen Rahmen kann mann schnell als Formatierung übersehen!
Also danke das ihr euch am Sonntag für mich Zeit genommen habt.
Schönen Sonntag noch
Gruß
Ulle

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..