Hallo,
ich erhalte aus einer Datenbank jeden Monat eine Exceltabelle. Diese hat neun Spalten (A bis I) und unterschiedlich viele Zeilen.
Ist es möglich aus Spalte B, die Worte enthält, die Daten auslesen zu lassen und alle Zeilen, die die gleichen Worte enthalten, in ein neues Arbeitsblatt zu verschieben, das dann auch die Bezeichnung des Wortes bekommt?
Beispiel: Spalte B enthält diverse Zeilen mit Apfel, Birne, Ananas, Kirsche. Nun sollen alle Zeilen mit Apfel in ein neues Arbeitsblatt verschoben werden und das Arbeitsblatt den Namen Apfel bekommen. Das Gleiche soll dann auch mit Birne, Ananas und Kirsche geschehen.
Vielen Dank für die Mühe
Oliver
ich erhalte aus einer Datenbank jeden Monat eine Exceltabelle.
Diese hat neun Spalten (A bis I) und unterschiedlich viele
Zeilen.
Ist es möglich aus Spalte B, die Worte enthält, die Daten
auslesen zu lassen und alle Zeilen, die die gleichen Worte
enthalten, in ein neues Arbeitsblatt zu verschieben, das dann
auch die Bezeichnung des Wortes bekommt?
Hi Oliver,
Alt+F11, Einfügen–Modul, Code reinkopieren.
Die zwei Codezeilen wo hinten Anpassen steht ggfs. anpassen.
Editor schließen.
Makro ausführen lassen mit Alt+F8 …
Option Explicit
'
Sub Obst()
Dim ZeiQ As Long, ZeiZ As Long, Obst, Z As Integer, wks As Worksheet
Dim Vorh As Boolean
Obst = Array("Apfel", "Birne", "Ananas", "Kirsche") 'Anpassen
ReDim O(UBound(Obst))
For Z = 0 To UBound(Obst)
Vorh = False
For Each wks In ThisWorkbook.Worksheets
If UCase(wks.Name) = UCase(Obst(Z)) Then
Vorh = True
Exit For
End If
Next wks
If Vorh = False Then
Worksheets.Add
ActiveSheet.Name = Obst(Z)
End If
Next Z
With Worksheets("Tabelle1") 'Anpassen
For ZeiQ = 1 To .Range("B" & Rows.Count).End(xlUp).Row
For Z = 0 To UBound(Obst)
If UCase(Obst(Z)) = UCase(.Cells(ZeiQ, 2).Value) Then
O(Z) = O(Z) + 1
.Rows(ZeiQ).Copy Destination:=Worksheets(Obst(Z)).Cells(O(Z), 1)
Exit For
End If
Next Z
Next ZeiQ
End With
End Sub
Gruß
Reinhard
Uiii…
Das ging ja schnell.
Vielen Dank, das versuche ich mal.
Oliver