Herbers Excel/VBA-Archiv

Makro-Code wo und wie ändern?

• Makro-Code wo und wie ändern? von Frank vom 07.10.2020 10:17:05
• Doppelt owT - von UweD am 07.10.2020 10:19:58

Betrifft: Makro-Code wo und wie ändern? von: Frank
Geschrieben am: 07.10.2020 10:17:05

Hallo zusammen,


freundlicherweise wurde mir vor ein paar Wochen hier schon mal mit dem Erstellen eines Makro-Codes geholfen. Die Tabelle, auf die der Code angewendet wird, wurde mittlerweile um eine Spalte A erweitert, dadurch müsste in dem Makro jetzt nicht mehr die Spalte "i" sondern die Spalte "j" ausgewertet werden. Ich dachte mir: "So schwer kann das ja nicht sein" und habe ein wenig herumexperimentiert, aber die Auswertung funktioniert leider nicht mehr. Kann mir bitte jemand sagen, wo bzw. wie der Makro-Code durch die Erweiterung der Spalte verändert werden muss? Hier der alte Code:



Option Explicit

Public Sub Exportieren()
Dim loSpalte As Long, i As Long

Application.ScreenUpdating = False

With Worksheets("Daten-Tabelle")
    loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 2).Column
    .Columns("I").Copy
    .Cells(1, loSpalte).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    .Columns(loSpalte).TextToColumns Destination:=.Cells(1, loSpalte), _
    DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False, _
    Space:=True, Other:=True, OtherChar:="-", FieldInfo:=Array(Array(1, 1), _
    Array(2, 1)), TrailingMinusNumbers:=True
    .Columns(loSpalte).RemoveDuplicates Columns:=1, Header:=xlYes
    For i = 2 To .Cells(.Rows.Count, loSpalte).End(xlUp).Row
        .Range("A1").AutoFilter field:=9, Criteria1:=.Cells(i, loSpalte) & "*"
        .AutoFilter.Range.Copy Worksheets("Export").Range("A1")
        Worksheets("Export").Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & .Cells(i, loSpalte) & ".xlsx"
        ActiveWorkbook.Close False
        Worksheets("Export").Cells.ClearContents
    Next i
    .Range("A1").AutoFilter
    .Columns(loSpalte).Resize(, 10).ClearContents
End With
Worksheets("Export").Cells.ClearContents
    
End Sub

  

Betrifft: Doppelt owT
von: UweD
Geschrieben am: 07.10.2020 10:19:58