Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1732to1736
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-Hilfe

VBA-Hilfe
08.01.2020 15:25:33
Dave
Hallo zusammen,
bin totaler VBA-Laie und habe daher eine Frage zu einem funktionierenden VBA-Code (gefunden im _
Internet). Dieser sieht so aus:


Sub Test()
Dim MyDic As Object, rng As Range, Zelle As Range, ws As Worksheet, wb As Workbook
Application.ScreenUpdating = False
Set MyDic = CreateObject("Scripting.Dictionary")
Set ws = ActiveSheet
With ws
Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
For Each Zelle In rng.Offset(1, 0)
If MyDic(Zelle.Value) = "" And Not IsEmpty(Zelle) Then
MyDic(Zelle.Value) = 1
rng.AutoFilter field:=1, Criteria1:=Zelle
Set wb = Workbooks.Add
.UsedRange.SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Cells(1, 1)
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & Zelle & ".xlsx", FileFormat:=51
wb.Close False
rng.AutoFilter
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Dieser Code splittet die Datei mit den Daten aus der Spalte A in jeweils neue Dateien, wobei der Dateiname auch aus der Spalte A entnommen wird. Allerdings möchte ich Daten und den Dateiname - in meinem Fall - aus der Spalte DS entnehmen. Kann mir da jemand helfen?

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

Betreff
Datum
Anwender
Anzeige
AW: VBA-Hilfe
08.01.2020 15:29:27
Daniel
HI
Set rng = .Range(.Cells(1, "DS"), .Cells(.Rows.Count, "DS").End(xlUp))
der Rest bleibt
Gruß Daniel
AW: VBA-Hilfe
08.01.2020 15:34:18
Dave
Hi Daniel,
super, vielen lieben Dank für die schnelle Hilfe :-)
Gruß
Deenay
AW: VBA-Hilfe
08.01.2020 15:32:20
Rudi
Hallo,
so?

Sub Test()
Dim MyDic As Object, rng As Range, Zelle As Range, ws As Worksheet, wb As Workbook
Application.ScreenUpdating = False
Set MyDic = CreateObject("Scripting.Dictionary")
Set ws = ActiveSheet
With ws
Set rng = .Range(.Cells(1, 123), .Cells(.Rows.Count, 123).End(xlUp))
For Each Zelle In rng.Offset(1, 0)
If MyDic(Zelle.Value) = "" And Not IsEmpty(Zelle) Then
MyDic(Zelle.Value) = 1
rng.AutoFilter field:=1, Criteria1:=Zelle
Set wb = Workbooks.Add
.Columns(123).SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Cells(1, 1)
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & Zelle & ".xlsx", FileFormat:=51
wb.Close False
rng.AutoFilter
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Gruß
Rudi
Anzeige
AW: VBA-Hilfe
08.01.2020 15:37:23
Dave
Hi,
Daniel war hier noch schneller mit der Antwort. Aber vielen Dank!
Gruß Deenay

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige