Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1696to1700
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Excel Datei mittels Spaltenüberschrift teilen

VBA Excel Datei mittels Spaltenüberschrift teilen
05.06.2019 17:13:31
Zdravko
Hallo Zusammen,
mein erster Beitrag hier und ich würde gerne wissen ob es die Möglichkeit gibt eine Excel Datei mit VBA aufzuteilen in mehrere Dateien in Abhängigkeit der Spaltenüberschrift.
Sprich es schaut wie folgt aus:
In Spalte A-G stehen Werte (Artikeldaten) die für alle Dateien gleich sind. Ab Spalte H fangen die Listenpreise pro Land an und ab Spalte AT die Verkaufszahlen zu den Ländern.
Ich will nun diese große Masterdatei in die jeweilige Länderdatei aufsplitten. Zum Beispiel soll eine Datei für Deutschland entstehen, die die Artikeldaten (Spalte A-G) enthält, den Listenpreis Deutschland Spalte I und die Verkaufszahlen Spalte AU-AW. Das gleiche Spiel dann für z.B. Italien nur das die Spalten für den Listenpreis und die Verkausfszahlen andere sind.
Ich habe jeder Spalte eindeutige Überschriften in Zeile 1 zugeordnet, da ich per Index-Formel und Namen aus anderen Dateien die Listenpreise und Verkaufszahlen kopiere. Auf diese Überschriften will ich nun mit dem Makro zugreifen und die Spalten in eine neue länderspezifische Datei kopieren.
Ich hoffe es ist verständlich was ich bezwecken will mit dem Makro.
LG Zdravko

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Musterdatei?
05.06.2019 17:16:30
UweD
die hilft
AW: VBA Excel Datei mittels Spaltenüberschrift teilen
06.06.2019 08:54:25
Zdravko
https://www.herber.de/bbs/user/130236.xlsx
Hier ein Beispiel wie die Datei ausschaut. Wie gesagt Spalte A-H immer kopieren und ab Spalte I den Listenpreis plus die Verkaufszahlen ab Spalte AU. Für Deutschland wäre es Spalte I und Spalte AU - AX.
Macht es eventuell Sinn in der Masterdatei die Länderspalten vorher zu Blöcken zusammen zu führen um sie dann per VBA zu kopieren?
LG Zdravko
AW: VBA Excel Datei mittels Spaltenüberschrift teilen
06.06.2019 10:51:31
UweD
Hallo
so?
Option Explicit

Sub Aufteilen_Länder()
    Dim Land, Arr(), TB1, WB, TBL, Spalte As Integer, Res As Integer
    Dim Pfad As String, Datei As String, Ext As String, Finde As String
    Dim WF, LC As Integer, RNG As Range, Offs As Integer, ErrMeld As String
    
    '****anpassen 
    'Länder 
    Arr = Array("DE", "CH", "FR", "IT", "NL", "SE", "GB", "US", "AU", "JP", "SG", "SK", "CN")
    
    Pfad = "X:\Temp\" 'mit \am Ende 
    Ext = ".xlsx"
    
    Offs = 8 'immer kopieren bis H 
    Res = 4 '4 Spalten bei Umsatz 
    
    
    Set TB1 = ThisWorkbook.Sheets("Tabelle1")
    '****Ende anpassen 
    
    
    
    
    
    Set WF = WorksheetFunction
    
    Application.ScreenUpdating = False
    
    With TB1
        LC = .Cells(1, .Columns.Count).End(xlToLeft).Column 'letzte Spalte der Zeile 1 
        Set RNG = .Cells(1, Offs + 1).Resize(1, LC - Offs) 'Suchbereich ab I 
    
        For Each Land In Arr
            'Neue Datei 
            Set WB = Workbooks.Add
            Set TBL = WB.Sheets(1)
            
            'immer kopieren 
            .Columns(1).Resize(, Offs).Copy TBL.Columns(1)
            
                
            'Spalte Listenpreis finden 
            Finde = "*M" & Land & "1*"
            If WF.CountIf(RNG, Finde) > 0 Then
                Spalte = WF.Match(Finde, RNG, 0) + Offs
            
                'Listenpreis kopieren 
                LC = TBL.Cells(1, TBL.Columns.Count).End(xlToLeft).Column + 1 'erste freie Spalte 
                .Columns(Spalte).Copy TBL.Columns(LC)
                LC = LC + 1
                
                'Spalte Umsatz finden 
                Finde = "AC Ext. Net Sales M" & Land & "1*"
                If WF.CountIf(RNG, Finde) > 0 Then
                    Spalte = WF.Match(Finde, RNG, 0) + Offs
                    
                    'Umsatz plus weitere Spalte kopieren 
                    .Columns(Spalte).Resize(, Res).Copy TBL.Columns(LC)
                    
                Else
                    MsgBox "Umsatz für '" & Land & "' nicht gefunden"
                    ErrMeld = ErrMeld & ", " & Land
                End If
                
            Else
                MsgBox "Listenpreis für '" & Land & "' nicht gefunden"
                ErrMeld = ErrMeld & ", " & Land
            End If
            
            'Datei speichern 
            With WB
                'Name festlegen  Land_Datum_Uhrzeit 
                Datei = Pfad & Land & "_" & Format(Now, "YYYYMMDD_hhmmss") & Ext
                
                .SaveAs Filename:=Datei, FileFormat:=xlOpenXMLWorkbook
                .Close
            End With
        Next
    End With
    
    If ErrMeld <> "" Then
        ErrMeld = vbLf & vbLf & Mid(ErrMeld, 3) & " unvollständig!"
    End If
    MsgBox "Fertig" & ErrMeld
End Sub

LG UweD
Anzeige
AW: VBA Excel Datei mittels Spaltenüberschrift teilen
07.06.2019 10:35:26
Zdravko
Hallo Uwe,
VIELEN DANK FÜR DIE SEHR SCHNELLE ANTWORT!
Ich werde es nächste Woche ausprobieren und melde mich dann. Bin jetzt im Urlaub und habe die Datei nicht mit. Aber soweit ich das überschauen kann im Code sieht es gut aus.
LG Zdravko

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige