'Merging csv files deletes data

I need to choose and merge multiple csv files. All are in the same structure, however the name of file and sheets change. The separator is ;

The code merges the data but seems to delete some rows. Because after the merge it ruins the structure and after I want to transfer data to column it says the data is already there do you want to delete it?

And the transformation deletes some rows.

Sub mergeAllFiles_MULTIPLE()

    Dim This As Workbook 'Store the book with the macro
    Dim TmpB As Workbook 'store the book that has the sheets (one per book)
    Dim AllB As Workbook 'book to send all the books
    Dim sht As Worksheet 'the only sheet every book

    Dim FileNames As Variant
    Dim Msg As String
    Dim I As Integer

    Set This = ThisWorkbook
    FileNames = Application.GetOpenFilename(MultiSelect:=True)
    If IsArray(FileNames) Then
        Workbooks.Add 'add a new book to store all the sheets
        Set AllB = ActiveWorkbook
        AllB.SaveAs This.Path & "\allSheetsInOne" & SetTimeName & ".xlsx", 51
        'The function is to store a different name every time and avoid error
        Msg = "You selected:" & vbNewLine

        For I = LBound(FileNames) To UBound(FileNames)
            Workbooks.Open FileName:=FileNames(I)
            Set TmpB = ActiveWorkbook
            TmpB.Activate
            Set sht = ActiveSheet 'because you say that the book has only one sheet
            sht.Copy Before:=AllB.Sheets(Sheets.Count) 'send it to the end of the sheets
            TmpB.Close 'we don't need the book anymore
            Set TmpB = Nothing 'empty the var to use it again
            Set sht = Nothing
            Msg = Msg & FileNames(I) & vbNewLine
        Next
        
       'UpdatebyExtendoffice
        Dim J As Integer
        On Error Resume Next
        Sheets(1).Select
        Worksheets.Add
        Sheets(1).Name = "Master"
        Sheets(2).Activate
        Range("A1").EntireRow.Select
        Selection.Copy Destination:=Sheets(1).Range("A1")
        For J = 2 To Sheets.Count
            Sheets(J).Activate
            Range("A1").Select
            Selection.CurrentRegion.Select
            Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
            Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
        Next
        
        'DELETESHIT
        Dim xWs As Worksheet
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Master" Then
            xWs.Delete
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
           
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1)), TrailingMinusNumbers:=True
    
    ActiveSheet.Range("$A$1:$XFD$1048576").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, _
        7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, _
        34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, _
        60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80), Header:=xlNo
        
    End If
End Sub


Function SetTimeName()
Dim YY
Dim MM
Dim DD
Dim HH
Dim MI
Dim SS
Dim TT

YY = Year(Date)
MM = Month(Date)
DD = Day(Date)
HH = Hour(Now)
MI = Minute(Now)
SS = Second(Now)

TT = Format(YY, "0000") & Format(MM, "00") & Format(DD, "00") & Format(HH, "00") & Format(MI, "00") & Format(SS, "00")

SetTimeName = TT
End Function

If I removed the condition to resume next. The error is given at

Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

After the merge of the files, in some rows it separates the data to 2 columns not just in 1.



Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source