Änderung XP zu 2007 - Paste Methode
Wolfgang
den nachfolgenden Code habe ich vor langer Zeit hier aus dem Forum erhalten und er lief unter XP immer gut und sauber. Nun setze ich Excel 2007 ein und es erscheint eine Fehlermeldung "Die Paste-Methode des Worksheet-Objektes konnte nicht ausgeführt werden". Hängt das evtl. mit der Umstellung von XP auf 2007 zusammen? Wie könnte ich die Fehlermeldung bzw. evtl. auch den Fehler abfangen? - Kurios dabei ist, dass trotzdem die Daten in das neu erstellte Tabellenblatt kopiert werden, der Code aber dann ab ActiveSheet.Paste stoppt. - Danke schon jetzt für die Rückmeldungen.
Gruß - Wolfgang
Private Sub Grund()
' Variablendeklaration
Dim intCounter As Integer
Dim shSource As Worksheet
Dim lngRow As Long
Dim wb As Workbook
Dim sport As String
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Set shSource = Sheets("Grunddaten")
For intCounter = 1 To 16
'Wenn eine Auswahl erfolgte, dann
If Controls("cbbKriterium" & intCounter).ListIndex -1 Then
'Kriterium festlegen
Select Case Controls("cbbKriterium" & intCounter).Value
Case "(Alle)"
shSource.Range("A1").Autofilter Field:=intCounter '(Alle) anzeigen
Case "(Leere)", ""
shSource.Range("A1").Autofilter Field:=intCounter, Criteria1:="=" '(Leere) filtern
Case "(NichtLeere)"
shSource.Range("A1").Autofilter Field:=intCounter, Criteria1:="" '(Nichtleere) _
filtern
Case Else
With Controls("cbbKriterium" & intCounter)
If intCounter = 3 Then
shSource.Range("A1").Autofilter Field:=intCounter, _
Criteria1:=CDate(.Value)
Else
If IsNumeric(.Value) Then
If IsDate(.Value) Then
shSource.Range("A1").Autofilter Field:=intCounter, _
Criteria1:=CDate(.Value)
Else
shSource.Range("A1").Autofilter Field:=intCounter, _
Criteria1:=CDbl(.Value)
End If
Else
shSource.Range("A1").Autofilter Field:=intCounter, _
Criteria1:=.Value
End If
End If
End With
End Select
End If
Next intCounter
' Alle sichtbaren Zellen kopieren
shSource.Range("A1").CurrentRegion.Copy
' Neues Arbeitsblatt hinzufügen
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Paste
' Autofilter ausschalten
shSource.Range("A1").Autofilter
' Kopiermodus ausschalten
Application.CutCopyMode = False
Range("A1").Select
'wb.Activate
'Rows("1:1").Select
' Dialog beenden
Unload Me
Set fd = Nothing
End Sub