Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1464to1468
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

Import einer Exceldatei ohne Absätze (mit Makro)

Import einer Exceldatei ohne Absätze (mit Makro)
06.01.2016 15:39:25
Christian
Hallo und ein gesundes neues Jahr für alle hier im Forum,
ich habe mal wieder ein Problem mit einem Import über ein Makro.
Ich bekomme täglich eine Datei in folgender Form bereitgestellt:
https://www.herber.de/bbs/user/102616.xlsx
Diese Datei benötige ich ohne Absätze und als fortlaufende Tabelle. Dazu ist wichtig, dass die Überschrift eines Blocks (in Spalte A) vor jedem Datensatz (Zeile) steht. Als Beispiel hab ich dazu ein Muster angehängt:
https://www.herber.de/bbs/user/102617.xlsx
Am liebsten hätte ich einen Importbutton mit einer Dateiauswahl, wo ich die tägliche Datei auswählen kann. Das Makro importiert dann die Datensätze in ein neues Arbeitsblatt und benennt das Arbeitsblatt mit dem Datum der Importdatei.
Kann mir damit jemand helfen?
Vielen Dank schonmal im Vorraus :)
LG Christian

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Import einer Exceldatei ohne Absätze (mit Makro)
06.01.2016 15:51:02
selli
hallo christian,
auftragsprogrammierung findest du hier: https://www.herber.de/develop.htm
gruß
selli

AW: Import einer Exceldatei ohne Absätze (mit Makro)
06.01.2016 16:52:51
UweD
Hallo
so?

Sub TT()
On Error GoTo Fehler
Dim Vorgabe$, Pfad$, i%
Dim LR&, Dlg As FileDialog
Application.ScreenUpdating = False
Vorgabe = "Musterdatei" ' Nur Dateien mit einem bestimmten Muster werden gelistet
Pfad = "C:\Temp\" ' Anfangsverzeichnis
Set Dlg = Application.FileDialog(msoFileDialogFilePicker)
With Dlg
.AllowMultiSelect = False
.InitialFileName = Pfad & Vorgabe & "*"
.InitialView = msoFileDialogViewDetails
.Title = "Datei auswählen"
End With
If Dlg.Show = True Then
Workbooks.Open FileName:=Dlg.SelectedItems(1)
With ActiveSheet
LR = .Cells(Rows.Count, 15).End(xlUp).Row 'letzte Zeile der Spalte O
' Spalte 1 Füllen
For i = 3 To LR
If .Cells(i, 2)  "" Then
.Cells(i, 1) = .Cells(i - 1, 1)
End If
Next
'Leerzeilen löschen
If .AutoFilterMode Then .AutoFilterMode = False ' Autofilter ausschalten
.Range("A:Z").AutoFilter Field:=2, Criteria1:="="
.Rows("2:" & LR).Delete Shift:=xlUp
.AutoFilterMode = False
.Cells.EntireColumn.AutoFit
End With
End If
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Gruß UweD
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige