Sortieren nach X und Rest löschen

Moin, moin,
ich brauche noch einmal Hilfe. Ich sortiere mit einem Makro gewisse Daten aus einer aktiven Tabelle raus und lösche damit alle nicht benötigten Zeilen. Im Beispiel sortiert er mir wenn in Spalte J (Spalte 10) nicht Hamburg steht alle anderen in den Müll. Passt. Hier das Beispiel :


Sub SortierenHamburg()
Dim lngZeile As Long
Dim lngZaehler As Long
Application.ScreenUpdating = False
For lngZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 2 Step -1
If Cells(lngZeile, 10)  "Hamburg" Then
Rows(lngZeile).Delete shift:=xlUp
lngZaehler = lngZaehler + 1
End If
Next lngZeile
Application.ScreenUpdating = True
End Sub

Nun möchte ich mit dem gleichen Makro die zweite Tabelle ansprechen. Er soll also den gleiche Funktion durchführen nur in einem anderen Arbeitsblatt der selben Mappe. Ich habe versucht aus "ActiveSheet" irgendwie Workbook und was weiß ich zu machen, ich scheitere jedoch kläglich.
Hat jemand eine Idee ? Es ist wahrscheinlich wieder nur eine Kleinigkeit...
Dankbar für jeden Hinweis !

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub SortierenHamburg() Dim lngZeile As Long Dim lngZaehler As Long With Tabelle2 Application.ScreenUpdating = False For lngZeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row To 2 Step -1 If .Cells(lngZeile, 10) "Hamburg" Then .Rows(lngZeile).Delete shift:=xlUp lngZaehler = lngZaehler + 1 End If Next lngZeile Application.ScreenUpdating = True End With End Sub

Matthias kannst Du mir noch mal helfen ?
Ich muss nun das tabelle3 blatt wieder aus der ersten seite heraus autom. als csv datei speichern im gleichen ordner wo die excel datei liegt. mit dem blatt wo die buttons liegen kriege ich es wie folgt hin :
Dim intFileNumber As Integer
Dim lngRow As Long
Dim vntArray As Variant
Dim strText As String
Dim i As Integer
Const strPre As String = ";"
Reset
intFileNumber = FreeFile
With ThisWorkbook
.Save
Open .Path & "\" & Left$(.Name, Len(.Name) - 4) & _
".csv" For Output As #intFileNumber
End With
With ActiveSheet.UsedRange
For lngRow = 1 To .Row + .Rows.Count - 1
vntArray = Range(Cells(lngRow, 1), _
Cells(lngRow, .Column + .Columns.Count - 1))
vntArray = WorksheetFunction.Transpose( _
WorksheetFunction.Transpose(vntArray))
strText = Join(vntArray, strPre)
Print #intFileNumber, strText
Next
End With
Close #intFileNumber
Application.DisplayAlerts = False
Application.Quit
Kann ich da auch wieder mit "with tabelle3" arbeiten ? wenn ja, an welcher stelle ? oder hast du einen anderen lösungsvorschlag ?

With Tabelle3.UsedRange For lngRow = 1 To .Row + .Rows.Count - 1 vntArray = .Range(.Cells(lngRow, 1), _ .Cells(lngRow, .Column + .Columns.Count - 1)) vntArray = WorksheetFunction.Transpose( _ WorksheetFunction.Transpose(vntArray)) strText = Join(vntArray, strPre) Print #intFileNumber, strText Next End With

Sub csv() With Tabelle3.UsedRange For lngRow = 1 To .Row + .Rows.Count - 1 vntArray = .Range(.Cells(lngRow, 1), _ .Cells(lngRow, .Column + .Columns.Count - 1)) vntArray = WorksheetFunction.Transpose( _ WorksheetFunction.Transpose(vntArray)) strText = Join(vntArray, strPre) Print #intFileNumber, strText Next End With End Sub

'Code des Blatts Abc: Option Explicit Private Sub cbSortAbc_Click() SortierenHamburg ActiveSheet End Sub Private Sub cbSortDdeeff_Click() SortierenHamburg Sheets("Ddeeff") End Sub 'Allg. Modul: Option Explicit Sub SortierenHamburg(wks As Worksheet) Dim lngZeile As Long ' Dim lngZaehler As Long ' wofür? Application.ScreenUpdating = False With wks For lngZeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row To 2 Step -1 If .Cells(lngZeile, 10) "Hamburg" Then .Rows(lngZeile).Delete shift:=xlUp ' lngZaehler = lngZaehler + 1 ' wofür? End If Next lngZeile End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Sortieren nach X und Rest löschen

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread