vielleicht kann Mustafa (war mir schon einmal eine große Hilfe) oder sonst jemand mir bei einer Format-Kopier-Frage helfen! Komm einfach nicht darauf, wie man den Code für das Kopieren der Formate(Farbe der Zellen, Kommentare) bei dem nachfolgenden Skript so umschreibt, dass es funktioniert.
Hab zwar schon eine Lösung gefunden, die aber den Programmablauf um einiges verlangsamt.
nachfolgend steht das komplette Skript oder eine Beispieldatei:
https://www.herber.de/bbs/user/38442.xls
Hier die Codezeile um die es mir geht:
Dieser Vorgang soll z. B. (Farbe der Zellen,Kommentare) mit auf die einzelnen Blätter von der Haupttabelle mitkopiert!!!
Sheets(a).Cells(x, J) = Ws1.Cells(I, J)
mit dieser Skriptzeile funktionierts, aber sehr langsam.
'Ws1.Cells(I, J).Copy Sheets(a).Cells(x, J)
Komplettes Skript:
Option Explicit
Sub VonGesamtNachEinzelnKopieren()
Application.ScreenUpdating = False
'Initialisieren der Variablen
Dim I&, J&, LZ1&, LS1&, LZ2&, LS2&, a&, x&, y&, z&
Dim MainDat As String
Dim Ws1 As Worksheet
MainDat = "gesamt"
Set Ws1 = Sheets(MainDat)
LZ1 = GetLastRow(Ws1)
LS1 = GetLastCol(Ws1)
I = 6
x = 7
y = 7
z = 65536
Do While I < LZ1
I = I + 1
For J = 1 To LS1
For a = 2 To Sheets.Count
If InStr(1, UCase(Ws1.Cells(I, 1)), LCase(Sheets(a).Name), 1) Then
If Sheets(a).Cells(z, 1).End(xlUp).Offset(1, 0).Row < y Then x = y
Application.StatusBar = "Datenblatt: [ " & Sheets(a).Name & " ] wird bearbeitet II Kopiervorgang..."
'Es geht mir um diesen Teil hier:
Sheets(a).Cells(x, J) = Ws1.Cells(I, J) '<<<<<<<<<<<<<<
'Ws1.Cells(I, J).Copy Sheets(a).Cells(x, J) <<<<<<<<<<<<<< (2.Lösung)
End If
Next a
Next
x = x + 1
Loop
Set Ws1 = Nothing
Sheets(MainDat).Select
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Function GetLastCol(Ws As Worksheet) As Long
GetLastCol = Ws.Cells(1, Columns.Count).End(xlToLeft).Column
End Function
Function GetLastRow(Ws As Worksheet) As Long
GetLastRow = Ws.Range("A65536").End(xlUp).Row
End Function
___
Vielleicht ist es verständlicher, wenn man sich die Mappe anschaut.
Bin für jeden Vorschlag dankbar.
Gruß doey