Rueckmeldung an alle
19.06.2013 17:06:31
Martin
hallo ihr lieben helfer!
vielen dank, dass ihr mir so rasch helfen konntet. ich habe letztlich den code von erich g. genommen, musste nur von thisWorkbook auf activWorkbook aendern, und das loeschen anpassen. unter 'Tabellenblatt ist er nun zu finden. nun funktioniert alles wie es sol! vielen herzlichen dank nochmals!
ich habe mein gesamtes sub nochmals angefuegt.
eine frage zu dem sub habe ich noch, wie kann ich leere worksheets loeschen? mit der specialCells methode bin ich nicht weit gekommen, da die zu durchsuchenden sheets zu gross sind (da haengt sich das system auf!)
vielen dank nochmals an alle,
liebe gruesse,
martin
Sub SectorID()
Dim strSectorID As String, OK As Boolean, i As Integer
Dim lngStartZeile As Long, lngEndeZeile As Long
Dim iSpalte As Integer
Dim ws As Worksheet
Dim idAbfrage As String
Dim c As Range
Dim wsBlatt As Worksheet
Dim strBlatt As String
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
'Sector ID eingeben
OK = True
strSectorID = Application.InputBox("Please enter the required Sector ID: ", "Sector ID _
Search", , , , , , 1)
For i = 1 To Len(strSectorID)
If Mid(strSectorID, i, 1) "9" Then
OK = False
Exit For
End If
Next
If strSectorID = "" Or OK = False Then
MsgBox "Wrong input - Only positive numbers are accepted!"
Exit Sub
End If
'Abfrage ob Sector ID existiert
Set ws = Sheets("SPOC-Contingency Task")
Set c = ws.Range("A:A").Find(strSectorID, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
Else
MsgBox "This Sector ID doesn't exist!"
Exit Sub
End If
'Tabellenblatt
strBlatt = "Sector ID " & strSectorID
For Each wsBlatt In ActiveWorkbook.Worksheets
If UCase$(wsBlatt.Name) = UCase$(strBlatt) Then
Application.DisplayAlerts = False
Sheets(strBlatt).Activate
ActiveSheet.Delete
'ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End If
Next wsBlatt
Worksheets.Add After:=Sheets("SPOC-Contingency Task")
ActiveSheet.Name = strBlatt
'ZeilenKopieren
Sheets(strBlatt).Select
Cells.Select
Selection.ClearContents
Range("A1").Select
Sheets("SPOC-Contingency Task").Select
ActiveSheet.Range("$a$1:$h$65536").AutoFilter Field:=1, Criteria1:=strSectorID, _
Operator:=xlAnd
For lngStartZeile = 2 To Cells.SpecialCells(xlCellTypeLastCell).row
If Rows(lngStartZeile).Hidden = False Then
Cells(lngStartZeile, 2).Select
Exit For
End If
Next
lngEndeZeile = Cells(Rows.Count, (1)).End(xlUp).row
lngEndeZeile = Cells(Rows.Count, "A").End(xlUp).row
Range(Rows(lngStartZeile), Rows(lngEndeZeile)).Select
Worksheets("SPOC-Contingency Task").Range("A1").CurrentRegion.SpecialCells( _
xlCellTypeVisible).Copy Worksheets(strBlatt).Range("A1")
'Spaltenbreite kopieren:
For iSpalte = 1 To ActiveSheet.UsedRange.columns.Count
Worksheets(strBlatt).columns(iSpalte).ColumnWidth = Worksheets("SPOC-Contingency _
Task").columns(iSpalte). _
ColumnWidth
Next iSpalte
'Sortierungsfilter deselektieren
Sheets("SPOC-Contingency Task").Select
Range("A1").Select
ActiveSheet.Range("$A$1:$H$65536").AutoFilter Field:=1
Sheets(strBlatt).Select
Range("A1").Select
ActiveSheet.Range("$A$1:$H$65536").AutoFilter Field:=1
Application.ScreenUpdating = True
ErrorHandler:
On Error GoTo 0
End Sub
/pre>