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
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
RowsMax1 = Import.UsedRange.Rows.Count
RowsMax1 =
CDbl
(Num1) +
CDbl
(RowsMax1)
Set
shtImport = Sheets(
"Import"
)
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
Application.ScreenUpdating =
False
If
UCase(Right(strFileName, 3)) <>
"CSV"
Then
MsgBox
"The file you select is not a CSV file!"
, vbCritical,
"Error!"
Exit
Sub
End
If
Range(
"A3:E320000"
).
Select
ActiveSheet.Range(
"$A$3:$E$320000"
).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
Header:=xlYes
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
Application.ScreenUpdating =
True
MsgBox
"The file "
& strFileName &
" was successfully imported on sheet "
& _
shtImport.Name &
"!"
, vbInformation,
"Done"
End
Sub