Excel und VBA: Formeln, Programmierung, Lösungen

StandardModule: basMain

Sub Filtern()
   Dim wks As Worksheet
   Dim rng As Range
   Dim iRow As Integer, iRowT As Integer
   Application.ScreenUpdating = False
   Set wks = Worksheets("Tabelle2")
   Set rng = Range("A1").CurrentRegion
   rng.Rows(1).Copy wks.Range("A1")
   iRow = 2
   iRowT = 1
   Do Until IsEmpty(Cells(iRow, 1))
      If WorksheetFunction.CountIf(rng.Rows(iRow), "vb0") > 0 Then
         iRowT = iRowT + 1
         rng.Rows(iRow).Copy wks.Cells(iRowT, 1)
      End If
      iRow = iRow + 1
   Loop
   wks.Columns.AutoFit
   Application.CutCopyMode = False
   Application.ScreenUpdating = False
End Sub

    

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Kopieren