Hello,

I'm trying to code a macro which will open all the workbooks in a directory.
copy all the fields row or column (without the headers (row 1) main information are on the four first column.
Copy these rows to the masterfile below each other but keeping the same within sheet "Result". starting from A2
the headers will be on A1:G1

I've found a code but it copy everything on column A instead of keeping the original format.
and i'm tried to understand arrays but i'm blocking on it since yesterday :/

Sub test2()    Dim Rng
    Dim sht As Worksheet
    Dim wbk As Workbook
    Dim Filename As String
    Dim Path As String
    Dim ThisBk As Workbook
    Dim Tgt As Range
    Dim Arr, a
    Dim c As Range
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Arr = Array("Nome", "Hora", "Type", "DATA EVENTO")
    Set ThisBk = ActiveWorkbook
    Path = ThisBk.Path & "\"
    Filename = Dir(Path & "*.xls*")
    Do While Len(Filename) > 0
        If Filename <> ThisWorkbook.Name Then
            Set wbk = Workbooks.Open(Path & Filename, UpdateLinks:=False)
                Call CopyNameClearSome
                Call TimeFormat
                Call SuspectEntries
            For Each sht In wbk.Worksheets
                For Each a In Arr
                    Set c = sht.Rows(1).Find(a)
                    If Not c Is Nothing Then
                        Set Tgt = ThisBk.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp)(2)
                        On Error Resume Next
                        Intersect(c.EntireColumn, sht.UsedRange).Copy Tgt
                        On Error GoTo 0
                    End If
                Next a
            Next sht
            wbk.Close savechanges:=False
        End If
        Filename = Dir
    Loop
    On Error Resume Next
    ThisBk.Sheets("Sheet1").Columns(1).SpecialCells(xlCellTypeBlanks).Delete
    ThisBk.Sheets("Sheet1").Columns(1).SpecialCells(xlCellTypeConstants, xlErrors).Delete
    On Error GoTo 0
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub