Wer kann mir den Code überprüfen.

Sub ErrorExp_Step3()
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim Spalte As Integer
Dim Zelle As Range
Dim I As Integer
Dim rows As Integer
Worksheets("QAL_Ges").Range("C7:H14").Copy
Set wb = Workbooks.Open("C:\Geradeauslauf\Q_Al\Q_Ges.xls")
With Workbooks("Q_Ges.xls")
.Worksheets("Q_ATL_Info").Select
'''.Range("R7:W14").ClearContents  <-- Das kann ich nicht umsetzen !!!
Range("R7").PasteSpecial Paste:=xlValues, Paste:=xlFormats
Range("W6").Activate
Worksheets("QA_DB").Select
'''Application.ScreenUpdating = False
End With
I = 2
For Spalte = 4 To 53
If Cells(I, Spalte).Value = "" Then Exit For
Next Spalte
For Each Zelle In Sheets(1).Range("W7:W14")
Cells(I, Spalte).Value = Zelle.Value
I = I + 1
Next
Application.ActiveWorkbook.Save
wb.Close False
Worksheets("QAL_Ges").Activate
With Worksheets("QAL_Ges")
Sheets(4).Range("H15") = Sheets(3).Range("I10").Value
Sheets(4).Range("H16") = Sheets(3).Range("I11").Value
Sheets(4).Range("H17") = Sheets(3).Range("I12").Value
Sheets(4).Range("H18") = Sheets(3).Range("I13").Value
Range("H7:H18").Copy
End With
Set wb = Workbooks.Open("C:\Geradeauslauf\Q_Al\QA_TL.xls")
With Workbooks("QA_TL.xls")
.Worksheets("Dia.ges").Select
Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 1).Select
Selection.PasteSpecial Paste:=xlValues
Worksheets(1).Activate
ActiveSheet.PageSetup.PrintArea = "$A$1:$M$44"
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End With
Application.CutCopyMode = False
Application.ActiveWorkbook.Save
wb.Close False
Worksheets("Daten").Activate
End Sub