Gültigkeit kopieren VBA
07.11.2003 07:32:20
Frank
ich habe folgendes Makro mit dem ich einen bestimmten Bereich kopiere und dann
in einer Schleife nur die Gültigkeit kopiere. Das Makro bleibt jedoch an einer
Stelle immer stehen:Selection.PasteSpecial Paste:=xlDataValidation.
Laufzeitfehler 1004: Die PasteSpecial Methode des Range Objektes ...
Tausche ich z.B. xlDataValidation durch xlFormats aus, läuft das Makro einwandfrei. Ich weiß nicht mehr weiter.
Gruß
Frank
Sub Gültigkeit()
Dim rng As Range
Dim intAkt As Integer, intAnf As Integer, _
intMax As Single, intStep As Integer
Dim zelle As Range, Anzahl As Single
Dim bereich As Range
Range("F12:AJ12").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween, Formula1:="-20", Formula2:="20"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Set bereich = Range("C8:C3000")
For Each zelle In bereich
If zelle.Borders(xlEdgeBottom).LineStyle <> xlNone Then intMax = intMax + 1
Next
intMax = intMax / 28
If Len(CStr(intMax)) > 2 Then
If MsgBox("Ungerade Anzahl an Linien ", vbOK) = vbOK Then
Exit Sub
End If
Else
End If
Application.ScreenUpdating = False
Set rng = Range("F12:AJ12")
intAnf = 40
intStep = 28
For intAkt = 0 To intMax - 2
rng.Copy
Cells(intAnf + (intStep * intAkt), 6).Select
Selection.PasteSpecial Paste:=xlDataValidation
Next intAkt
Range("B7").Select 'Wenn's sein muss ;-)
Application.ScreenUpdating = True
Set bereich = Nothing
End Sub