AW: Wo ist der Code? o.w.T.
18.07.2007 18:16:24
Hajo_Zi
Hallo Heinz,
Das verstehe ich nicht
"Es sollte von B4:K13 heissen " Range("B4:K13").Copy" es steht doch im Code Range("B4:K13").Copy
Ich kann das jetzt nicht Testen, da ich die Datei nicht nachbaue, darum live.
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Integer
'Bildschirmflackern aus
Application.ScreenUpdating = False
Sheets("R1").Unprotect
Sheets("R2").Unprotect
Sheets("R3").Unprotect
With Sheets("Tabelle")
For i = 1 To 40
If WorksheetFunction.CountIf(.Range("D4:D15"), i) >= 1 Then
.Range("B4:K13").Copy
'If i 1 Then
If MsgBox("Wollen Sie die Daten löschen.", vbYesNo + vbQuestion, "Lö _
schabfrage ?") = vbYes Then
.Range("B4").PasteSpecial Paste:=xlValues
End If
End If
.Range("B4").PasteSpecial Paste:=xlValues
End With
.Range("C16:D27").Copy
Sheets("R" & CStr(i)).Range("C18").PasteSpecial Paste:=xlValues
.Range("F21:F34").Copy
Sheets("R" & CStr(i)).Range("M2").PasteSpecial Paste:=xlValues
.Range("J21:J34").Copy
Sheets("R" & CStr(i)).Range("Q2").PasteSpecial Paste:=xlValues
.Range("G36").Copy
Sheets("R" & CStr(i)).Range("M17").PasteSpecial Paste:=xlValues
Exit For
End If
Next i
.Unprotect
.Range("C18:D29,F21:J34,C16:D27,G36").ClearContents
End With
Range("K23").Select
Sheets("R1").Protect
Sheets("R2").Protect
Sheets("R3").Protect
Sheets("R4").Protect
'Bildschirmflackern ein
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
Gruß Hajo