PDA

Vollständige Version anzeigen : Daten filtern und speichern...


RaynAnderson
18.07.2014, 17:48
Hallo,

Ich habe eine Tabelle A bis H.
In der Spalte A sind Abteilungen.

Nun möchte ich das die Tabelle nach einer Abteilung gefiltert wind z.B. AN-32
Das Ergebnis dann in einem Verzeichnis z.B. AN-32 gespeichert
Dann kommt die nächste Abteilung (alle Abteilungen sollten im Makro hinterlegt sein z.B. Als Array-Befehl)
Dies soll so oft wiederholt werden, bis alle Abteilungen durch sind...

Wie kann man das als Makro darstellen?

Kannst Du mir helfen? :(

Gruß

Rayn

Mc Santa
18.07.2014, 19:54
Hallo,

ist das eine Aufgabe die nur einmalig gemacht wird, oder immer wieder?
Und wie viele verschiedene Abteilungen gibt es?

Es gibt eine sehr schnelle Lösung von Hand mit einer PivotTabelle oder man programmiert etwas mithilfe des Spezialfilters. Es gab auch schon etwas ähnliches, vielleicht finde ich das noch :)

VG

RaynAnderson
18.07.2014, 20:38
Hallo,

Es sollte 15 mal wiederholt werden...
Ich suchen eine Makro-Lösung....

Wäre super wenn Du mir helfen könntest...

Gruß

Rayn

Mc Santa
19.07.2014, 00:54
Hallo,

anbei ein Makro und eine Datei zum Probieren :)
Option Explicit

Sub export()
Dim id As Long
Dim ber As Range, r As Range
Dim wks As Worksheet

For Each wks In Worksheets
If wks.Name <> "Quelle" Then
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
End If
Next wks

With Sheets("Quelle")
Set ber = .Range(.Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))

For Each r In ber

If Not sheetExists(CStr(r.Value)) Then
Set wks = ThisWorkbook.Worksheets.Add
wks.Name = r.Value
wks.Cells.Clear

wks.Cells(1, 1) = ber.Cells(1, 1)
wks.Cells(2, 1) = r.Value

.Range(.Cells(Rows.Count, 1).End(xlUp), .Cells(1, Columns.Count).End(xlToLeft)). _
AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=wks.Range(wks.Cells(1, 1), wks.Cells(2, 1)), _
CopyToRange:=wks.Cells(3, 1), Unique:=False
wks.Range("A1:A2").EntireRow.Delete
End If
Next r
End With
Application.DisplayAlerts = False
Worksheets(ber.Cells(1, 1).Value).Delete
Application.DisplayAlerts = True

End Sub

Function sheetExists(strNam As String) As Boolean
On Error Resume Next
sheetExists = Sheets(strNam).Index > 0
End Function

Freue mich über Feedback, Fragen gerne :)

VG

RaynAnderson
19.07.2014, 10:29
Hallo Mc Santa,

das Makro ist der Hammer :top: , wenn ich nur auch so programmieren können :o(

Ich müsste jetzt nur noch das Makro um zwei weitere Funktionen erweitern...

1.) Speicher in vorgegbenen Verzeichnissen auf dem Sheet 2
2.) versenden einer E-Mail an den dazugehörigen Abteilungsleiter, dass für seine Abteilung die Daten in seinem persönlichen Verzeichnis hinerlegt sind...



Würdest Du mir dabei helfen?:grinange:

Gruß

Rayn :o