Hallo,
Ich danke vielmals. Habe es jetzt nochmal getestet und den gesammten Code ein bissl schön gemacht und es Funzt alles so wie ich es gerne hätte.
Hier der Code:
Option Explicit
Sub ImportCSV()
Dim shtImport As Worksheet
Dim strFileName As String
Const Num1 As Long = 1
Dim RowsMax1 As Long
Dim RowsMax2 As Long
Dim Row As Long
' Delete Clear Rows
With Import
RowsMax2 = .UsedRange.Rows.Count
For Row = RowsMax2 To 4 Step -1
If Application.WorksheetFunction.CountA(.Rows(Row)) = 0 Then
.Rows(Row).Delete
End If
Next Row
End With
' Detect RowMax for Import
RowsMax1 = Import.UsedRange.Rows.Count
RowsMax1 = CDbl(Num1) + CDbl(RowsMax1)
' Change the name "Import" according to your sheet name.
Set shtImport = Sheets("Import")
' Show the file dialog and select a CSV file.
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Select a CSV file!"
.Filters.Clear
.Filters.Add "Semicolon Separated Values", "*.csv"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "You did't select a CSV file!", vbExclamation, "Canceled"
Exit Sub
Else
strFileName = .SelectedItems(1)
End If
End With
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFileName, Destination:=Range("$A" & RowsMax1))
.Name = "strFileName"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False '''
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(4, 2, 2, 2, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
' Turn OFF the Screenupdating
Application.ScreenUpdating = False
' Check if the selected file is CSV file.
If UCase(Right(strFileName, 3)) <> "CSV" Then
MsgBox "The file you select is not a CSV file!", vbCritical, "Error!"
Exit Sub
End If
' Remove duplicated Rows
Range("A3:E320000").Select
ActiveSheet.Range("$A$3:$E$320000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
Header:=xlYes
' Leere Zelen loeschen
With Import
RowsMax2 = .UsedRange.Rows.Count
For Row = RowsMax2 To 4 Step -1
If Application.WorksheetFunction.CountA(.Rows(Row)) = 0 Then
.Rows(Row).Delete
End If
Next Row
End With
' Turn ON the Screenupdating
Application.ScreenUpdating = True
' Inform the user about the process.
MsgBox "The file " & strFileName & " was successfully imported on sheet " & _
shtImport.Name & "!", vbInformation, "Done"
End Sub
|