Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.09.2025 18:34:36
Welches Datum gibt mein M-Code aus?
26.09.2025 10:29:46
Wert aus einer Zelle bei jeder Eingabe in neue Zelle
26.09.2025 08:51:00
Teilinhalt einer Zelle vergleichen
25.09.2025 23:04:12
Einen von drei möglichen Einträgen in einer Zeile suchen
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1900to1904
1900to1904
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

filtern & kopieren

Forumthread: filtern & kopieren

filtern & kopieren
15.10.2022 14:23:37
Olli
  • Mein Thema:
    Ich habe eine Beispieldatei hochgeladen (Exceldatei mit Makro). Es geht, darum, diese Datei mit allen drei Arbeitsmappen incls. der Makros in neue Excel Dateien zu kopieren. Dabei sollen die 3 Makros anschließend auch noch funktionieren.
    In der Spalte A der "MAList" stehen alle Führungskräfte. Das Makro soll nach Spalte A "Führungskräfte" filtern und im Endergebnis soll je Führungskraft eine neue Datei erzeugt
    werden. In dieser neuen Datei je Führungskraft sollen auch die Arbeitsmappen 2 (BVorlage) und 3( Summary) enthalten sein.
    Diese neuen Dateien sollen nach dem Namen der Führungskräfte aus Spalte A z.B. " 4711 Jäger" bzw. "4712 Schmitt" bzw. "4713 Ebert" erhalten.
    Die Datei enthält 3 Arbeitsmappen.
    1. Mitarbeiterliste "MAList"
    2. Beurteilungsvorlag "BVorlage"
    3. Zusammenfassung der Beurteilungsergebnisse "Summary"
    Danke
    Olli
    https://www.herber.de/bbs/user/155690.xlsm
    • Anzeige

    1
    Beitrag zum Forumthread
    Beitrag zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: filtern & kopieren
    15.10.2022 15:34:10
    Uduuh
    Hallo,
    in eine separate Datei und aus deiner Datei heraus starten:
    
Sub FK()
Dim objFK As Object, arrFK, i As Long, oObj
Dim wkb As Workbook
Dim strWkbFull As String
Dim rngDel As Range, rngC As Range, a As Range
strWkbFull = ActiveWorkbook.FullName
Set objFK = CreateObject("scripting.dictionary")
arrFK = ActiveWorkbook.Sheets("malist").Cells(1, 1).CurrentRegion.Resize(, 1)
Application.ScreenUpdating = False
For i = 2 To UBound(arrFK)
objFK(arrFK(i, 1)) = 0
Next
ActiveWorkbook.Close False
For Each oObj In objFK
Set wkb = Workbooks.Open(strWkbFull)
Set rngDel = Nothing
With wkb.Sheets("malist")
For Each rngC In Intersect(.Cells(1, 1).CurrentRegion, .Cells(1, 1).CurrentRegion.Offset(1)).Resize(, 1).Cells
If rngC.Value  oObj Then
If rngDel Is Nothing Then
Set rngDel = rngC
Else
Set rngDel = Union(rngDel, rngC)
End If
End If
Next rngC
If Not rngDel Is Nothing Then
For Each a In rngDel.Areas
a.EntireRow.Delete
Next a
End If
End With
With wkb
.SaveAs Filename:=Left(strWkbFull, Len(strWkbFull) - 5) & "_" & oObj, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close False
End With
Next oObj
End Sub
    Gruß aus'm Pott
    Udo
    Anzeige
    ;

    Beliebteste Forumthreads (12 Monate)

    Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
    Anzeige
    Anzeige
    Entdecke mehr
    Finde genau, was du suchst

    Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

    Suche nach den besten Antworten
    Unsere beliebtesten Threads

    Entdecke unsere meistgeklickten Beiträge in der Google Suche

    Top 100 Threads jetzt ansehen
    Anzeige