AW: Excel2013: Spalten, Zeilen durchsuchen
26.02.2015 09:11:49
Klaus
Hi Chris,
kopiere dir diesen Code in ein frisches Modul und starte dann das Makro.
Option Explicit
Sub SucheInAllen()
Const TabelleNeu As String = "Ausgabe" 'im Blatt "Ausgabe" auflisten
Const SpalteSuch As Long = 1 'in Spalte A = 1 suchen
Const SpalteWert As Long = 9 'Werte aus Spalte I = 9 übernehmen
Const SpalteOut As Long = 1 'Ausgabe ab Spalte A = 1
Const SucheNach As String = "C-" 'hiernach wird gesucht
Dim lZeile As Long
Dim lZeileNeu As Long
Dim myWks As Worksheet
Application.ScreenUpdating = False
If Not WksSheetExists(TabelleNeu) Then
Sheets.Add
ActiveSheet.Name = TabelleNeu
End If
For Each myWks In ActiveWorkbook.Worksheets
If Not myWks.Name = TabelleNeu Then
With Sheets(TabelleNeu)
lZeileNeu = .Cells(.Rows.Count, SpalteOut).End(xlUp).Row + 1
End With
With myWks
lZeile = .Cells(.Rows.Count, SpalteSuch).End(xlUp).Row
If .AutoFilterMode Then .Cells.AutoFilter 'Turns OFF Autofilter, if any
If .Range("A1").Value = "" Then .Range("A1") = "Filter"
.Range(.Cells(1, SpalteSuch), .Cells(lZeile, SpalteSuch)).AutoFilter 'Turns ON _
Autofilter on given range
.Cells(1, SpalteSuch).AutoFilter Field:=1, Criteria1:="=C-*"
.Range(.Cells(2, SpalteSuch), .Cells(lZeile, SpalteSuch)).SpecialCells( _
xlCellTypeVisible).Copy
Sheets(TabelleNeu).Cells(lZeileNeu, SpalteOut).PasteSpecial xlPasteValues
.Range(.Cells(2, SpalteWert), .Cells(lZeile, SpalteWert)).SpecialCells( _
xlCellTypeVisible).Copy
Sheets(TabelleNeu).Cells(lZeileNeu, SpalteOut + 1).PasteSpecial xlPasteValues
.Cells.AutoFilter 'Turns OFF Autofilter, if any
If .Range("A1").Value = "Filter" Then .Range("A1").Value = ""
Application.CutCopyMode = False
End With
End If
Next myWks
Application.ScreenUpdating = True
End Sub
Function WksSheetExists(sSheet As String) As Boolean
Dim wks As Object
On Error Resume Next
Set wks = Sheets(sSheet)
If Not wks Is Nothing Then
WksSheetExists = True
End If
On Error GoTo 0
End Function
Grüße,
Klaus M.vdT.
