AW: vba - koieren mit Nachkommastellen
25.05.2019 16:39:15
Daniel
Hi
bei mir werden die Formate korrekt übertragen (soweit ich das überblicken kann, ich habe jetzt nicht jeden deiner vielen Werte einzeln überprüft, bei deiner Tabelle wäre eventuell ein Hinweis angebracht, in welcher Zelle der Fehler auftritt)
vielleicht probierst du mal, vor dem Einfügen nicht nur die vorhandenen Inhalte, sondern auch die Formate zu löschen, damit hier keine "alten Reste" stehen, die eventuell weiter wirken, dh
.Clear statt .ClearContents
ggf kannst du auch auf den Spezialfilter verzichten, wenn du die Liste nach Kriterienspalte sortiest (ist sie ja wahrscheinlich schon) und dann das erste und letzte Vorkommen des Suchkriteriums ermittelst und dann alle dazwischenliegenden Zeilen kopierst.
das dürfte bei großen Datenmengen schneller sein als der Spezialfilter, außerdem kannst du beim Kopieren eines geschlossenen Zeilenblocks auch gleich die unerwünschten Spalten ausschließen, was dir das löschen erspart:
also in etwa so:
Sub nachFinal2()
Dim Z1 As Range
Dim Z2 As Range
Dim KopierSpalten As Range
With Sheets("Export")
Set KopierSpalten = .Range("A:AD,AN:AN,AY:GS")
.UsedRange.Sort key1:=.Cells(1, 5), order1:=xlAscending, Header:=xlYes
With .Columns(5)
Set Z1 = .Find(what:=Sheets("Kriterien").Range("H21"), _
searchdirection:=xlNext)
Set Z2 = .Find(what:=Sheets("Kriterien").Range("H21"), _
searchdirection:=xlPrevious)
End With
Sheets("Final").Cells.Clear
Intersect(.Rows(1), KopierSpalten).Copy _
Destination:=Sheets("Final").Cells(1, 1)
If Not Z1 Is Nothing Then _
Intersect(Range(Z1, Z2).EntireRow, KopierSpalten).Copy _
Destination:=Sheets("Final").Cells(2, 1)
End With
End Sub
Gruß Daniel