ich habe einen Code geschrieben, der gefilterte Zellen von einem Worksheet in ein anderes kopiert. Funktioniert soweit alles auch ganz gut, allerdings dauert das Kopieren zu lange. Ich denke mal das liegt daran, dass er immer zwischen den Sheets hin und her springt in der Schleife und jede Zelle einzeln auswählt. Wie kann ich hier eine schnellere Lösung erreichen?
Und was muss ich in meinem Code ändern, wenn ich die kopierten Zellen nicht in das gleiche Workbook einfügen will, sondern in eine komplett neue Datei?
Mein Code sieht folgendermaßen aus:
Private Sub CreateWorkCard_Click()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
j = 0
l = 0
'Übernehmen der Überschrift
ActiveWorkbook.Sheets("Test").Cells(2, 2).Value = _
ActiveWorkbook.Sheets("Work Card").Cells(2, 5).Value
'Format übernehmen
ActiveWorkbook.Sheets("Work Card").Range("E2").Copy
Worksheets("Test").Range("B2").PasteSpecial Paste:=xlPasteFormats
Do Until Me.Cells(9, 5 + j).Value = ""
i = 0
k = 0
Do Until Me.Cells(9 + i, 5).Value = ""
If Me.Rows(9 + i).Hidden = False Then
'Automatisches Einfügen der ausgewählten P/N
ActiveWorkbook.Sheets("Test").Cells(4, 2).Value = _
ActiveWorkbook.Sheets("Work Card").Cells(4, 5).Value & " " & _
ActiveWorkbook.Sheets("Work Card").Cells(9 + i, 4).Value
'Format übernehmen
ActiveWorkbook.Sheets("Work Card").Cells(4, 5).Copy
Worksheets("Test").Range("B4").PasteSpecial Paste:=xlPasteFormats
'Übernehmen der Informationen
ActiveWorkbook.Sheets("Test").Cells(5, 2).Value = _
ActiveWorkbook.Sheets("Work Card").Cells(5, 5).Value
'Format übernehmen
ActiveWorkbook.Sheets("Work Card").Cells(5, 5).Copy
Worksheets("Test").Range("B5").PasteSpecial Paste:=xlPasteFormats
'Übernehmen der eingeblendeten Tabelleninhalte
ActiveWorkbook.Sheets("Test").Cells(7 + k, 2 + l).Value = _
ActiveWorkbook.Sheets("Work Card").Cells(9 + i, 5 + j).Value
'Format übernehmen
ActiveWorkbook.Sheets("Work Card").Cells(9 + i, 5 + j).Copy
Worksheets("Test").Cells(7 + k, 2 + l).PasteSpecial Paste:=xlPasteFormats
k = k + 1
End If
i = i + 1
Loop
j = j + 1
l = l + 1
Loop
'Spaltenbreiten/Zeilenhöhen und Ausrichtung definieren
ActiveWorkbook.Sheets("Test").Columns(2).ColumnWidth = 95
ActiveWorkbook.Sheets("Test").Columns(3).ColumnWidth = 13
ActiveWorkbook.Sheets("Test").Columns(4).ColumnWidth = 13
ActiveWorkbook.Sheets("Test").Columns(5).ColumnWidth = 13
ActiveWorkbook.Sheets("Test").Columns(6).ColumnWidth = 20
ActiveWorkbook.Sheets("Test").Columns(7).AutoFit
Worksheets("Test").Rows.AutoFit
End Sub
Viele Grüße,Dominik