kann mir vielleicht jemand sagen was man tun muß um sich Dateien aus einem Ordner anzeigen zu lassen und bei auswahl einer datei diese dann in einem extra blatt zu öffnen?
Danke
Sub BlattEinfügen()
Dim fn
Dim wb As Workbook, wb2 As Workbook
Set wb = ActiveWorkbook
fn = Application.GetOpenFilename("Excel-Dateien (*.xls),*xls")
If fn = False Then Exit Sub 'Abbrechen geklickt
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(Filename:=fn)
wb2.Sheets(1).Copy After:=wb.Sheets(wb.Sheets.Count)
wb2.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
Sub BlattEinfügen()
Const Pfad = "D:\xl" 'anpassen
Dim fn
Dim wb As Workbook, wb2 As Workbook
Set wb = ActiveWorkbook
ChDrive Pfad
ChDir Pfad
fn = Application.GetOpenFilename("Excel-Dateien (*.xls),*xls")
If fn = False Then Exit Sub
'Pfad prüfen:
If UCase(Left(fn, InStrRev(fn, "\") - 1)) <> UCase(Pfad) Then
MsgBox "Falscher Pfad!"
Exit Sub
End If
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(Filename:=fn)
wb2.Sheets(1).Copy After:=wb.Sheets(wb.Sheets.Count)
wb2.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
Sub BlattEinfügen()
Dim fn
Dim wb As Workbook, wb2 As Workbook
Set wb = ActiveWorkbook
fn = Application.GetOpenFilename("Excel-Dateien (*.csv),*csv")
If fn = False Then Exit
Sub 'Abbrechen geklickt
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(Filename:=fn)
wb2.Sheets(1).Copy After:=wb.Sheets(wb.Sheets.Count)
With ActiveSheet
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileDecimalSeparator = "."
.Refresh BackgroundQuery:=False
End With
wb2.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
Danke