Code Beschleunigen?
12.06.2015 09:35:39
Stefan
ich Kopiere momentan aus 3 Sheets (Range ca. A1:Z40) in ein "gesamt" Sheet. Es werden noch einige Sheets dazu kommen und es dauert jetzt schon ziemlich lange.
Könnte man hier noch was optimieren?
Private Sub start_Click()
Dim zelle As Long
Dim i As Long
Dim iZeile As Integer
Dim z as Integer
Application.ScreenUpdating = False
Worksheets("SystemFMEA").Visible = xlSheetVisible
Worksheets("SystemFMEA").Select
Worksheets("OverAlL").Visible = xlVeryHidden
For i = 1 To Sheets.Count
If Sheets(i).Name "Menu" And Sheets(i).Name "SystemFMEA" And _
Sheets(i).Name "Analysis" And Sheets(i).Name "OverAll" _
And Sheets(i).Name "list" And Sheets(i).Name "FMEA" Then
With Worksheets(i)
z = .Range("N" & Rows.Count).End(xlUp).Row
For zelle = 13 To z
If IsNumeric(TextBox1.Value) = True And _
Worksheets("OverAlL").CheckBoxTech.Value = True _
And CheckBoxTech.Caption = .Range("B4").Value _
And Worksheets("OverAlL").CheckBoxProd.Value = True _
And CheckBoxProd.Caption = .Range("B4").Value _
And Worksheets("OverAlL").CheckBoxSys.Value = True _
And CheckBoxSys.Caption = .Range("B4").Value _
And Worksheets("OverAlL").CheckBoxTool.Value = True _
And CheckBoxTool.Caption = .Range("B4").Value _
And Worksheets("OverAlL").CheckBoxNon.Value = True _
And CheckBoxNon.Caption = .Range("B4").Value _
Or Worksheets("OverAlL").ComboBox2.Value = Sheets(i).Range("B3").Value _ _
Or Worksheets("OverAlL").ComboBox2.Value = "" Then
If .Range("N" & zelle).Value >= CInt(TextBox1.Value) _
And .Range("N" & zelle).Value "" Then
.Range("N" & zelle, "B" & zelle).Copy
iZeile = Sheets("SystemFMEA").Cells(.Rows.Count, 9).End(xlUp).Row
Sheets("SystemFMEA").Cells(iZeile + 1, 9).PasteSpecial xlPasteValues
.Range("B2").Copy
Sheets("SystemFMEA").Cells(iZeile + 1, 1).PasteSpecial xlPasteValues
.Range("B3").Copy
Sheets("SystemFMEA").Cells(iZeile + 1, 2).PasteSpecial xlPasteValues
End If
'Else: Exit Sub
End If
Next zelle
End With
End If
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Dankeschön :)
Grüße,
Stefan