Экспорт и последующий анализ данных spc - VBA - Ответ 5037972

Sub DataTransfer()
Dim mstr As String, mFlag As Boolean, i&, j&
 
   Application.ScreenUpdating = False
   
   If  ActiveSheet.UsedRange.Rows.Count > 1048576 - 10002 Then
        Sheets.Add After:=Sheets(Sheets.Count)
            Else
            Rows("1:10002").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
            
   With Application.FileDialog(msoFileDialogFilePicker)
      .InitialFileName = Application.DefaultFilePath & "\":  .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Canceled":   Exit Sub
                Else: mstr = .SelectedItems(1)
        End If
        mstr = "TEXT;" & mstr
   End With: [a1].Select
   With ActiveSheet.QueryTables.Add(Connection:= _
                                                      mstr, Destination:=ActiveCell)
        .TextFilePlatform = 1251:   .TextFileStartRow = 1
        .TextFileCommaDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
   End With
   With ActiveSheet.Range("A1:A10002")
        .Replace What:=",", Replacement:=";", LookAt:=xlPart, SearchOrder:=xlByRows
        .Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows
        .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=True, Comma:=False, Space:=False, Other:=False, TrailingMinusNumbers:=True
   End With
   j = 1
   For i = 2 To ActiveWorkbook.Sheets.Count
      If Sheets(i).Name = "MyExport_" & j Then j = j + 1
   Next 'i
    ActiveSheet.Name = "MyExport_" & j
    Call mRemoveDublicate_DeleteEmpty
    Application.ScreenUpdating = True
    Columns("A:AA").EntireColumn.AutoFit
    MsgBox Space(10) & "D O N E!"
End Sub

Sub mRemoveDublicate_DeleteEmpty()
Dim mRng As Range, i&, j&, mARR()
   Application.ScreenUpdating = False
   With ActiveSheet
      ReDim mARR(0 To .UsedRange.Columns.Count - 1)
      For i = 1 To .UsedRange.Columns.Count:  mARR(i - 1) = i:  Next i
      Set mRng = .Range(.[a1], .Cells(20004, .UsedRange.Columns.Count))
      mRng.RemoveDuplicates (mARR), xlNo
   End With
 
   With mRng
       For i = .Rows.Count To 3 Step -1
         If Application.CountA(.Rows(i)) < .Columns.Count Then .Rows(i).Delete
      Next 'i
   End With:    Set mRng = Nothing
   Application.ScreenUpdating = True
End Sub