in einer Mappe existiert einerseits ein Code, um für bestimmte Blätter dieser Mappe Pulldown zu starten. Ein weiterer Code kopiert Daten aus zwei Tabellen in eine dritte Tabelle. Beim Kopieren der Daten scheinen sich diese beiden Codes zu stören. Es erscheint dann im Code für die Pulldown eine Fehlermeldung, dass die Methode Intersect für die Methode Global fehlgeschlagen ist. Gibt es Möglichkeiten, dieser Fehlermeldung zu umgehen bzw. was muß ich verändern? Kann beim Kopieren evtl. der Code für die Pulldowns ausgeschaltet werden? - Ich habe 'mal beide Codes hier beigefügt. Danke schon jetzt auch wieder für die Rückmeldungen.
Herzliche Grüße
Wolfgang
'Der Code für die Pulldowns
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim strList As String
Dim rng As Range
If Not Sh.Name = "Start" And Not Sh.Name = "Gesamt" Then
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("I2:I6000")) Is Nothing Then
Set rng = Sh.Range("I2:I6000")
strList = "Zahl1 " & Chr(44) & "Zahl2 " & Chr(44) & "Zahl3 " & Chr(44) & _
"Zahl4 " & Chr(44) & "Zahl5 " & Chr(44)
End If
If Not Intersect(Target, Range("K2:K6000")) Is Nothing Then
Set rng = Sh.Range("K2:K6000")
strList = "Ja" & Chr(44) & "Nein"
End If
If Not Intersect(Target, Range("M2:M6000")) Is Nothing Then
Set rng = Sh.Range("M2:M6000")
strList = Date
End If
If strList = "" Then Exit Sub
rng.Validation.Delete
With Target.Validation
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=strList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = "Auweia"
.InputMessage = ""
.ErrorMessage = _
"Hier können Sie bitte nur das Listenfeld mit den Vorgaben nutzen."
.ShowInput = True
.ShowError = True
End With
Set rng = Nothing
End If
End Sub
'Der Code für das Kopieren
Option Explicit
Sub FilternUndKopieren()
Application.ScreenUpdating = False
With Sheets("Grunddaten")
.Unprotect
.Range("A1").Autofilter Field:=17, Criteria1:=">180"
Intersect(.Columns("A:R"), .Range(.Rows(2), .Rows(.Range("a1").CurrentRegion.Rows.Count))). _
Copy
Sheets("Altdaten").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormats
Sheets("Altdaten").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
.Range(.Rows(2), .Rows(.Range("a1").CurrentRegion.Rows.Count)).EntireRow.Delete shift:=xlUp
.Range("A1").Autofilter
.AutoFilterMode = False
.Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub