Copy values to masterfile looping through directory

  • Hello All,

    my macro is looping through a folder and then change the format of the files and name header.
    this is working good so far.
    i would like to copy these columns to my masterfile.
    i found a code but it only copy on range A so it doesnt keep the format.
    my objective is to copy all the columns (after the formating is done) to the master file and put the data below each other.

    the original code was using Arrays but i imagine that we may also use something else (except dictionary because the item or keys may have same values.
    could you help me with this please ?

    here is my code:


    Sub Consolidate()
    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 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
    On Error Resume Next
    ThisBk.Sheets("Sheet1").Columns(1).SpecialCells(xlCellTypeConstants, xlErrors).Delete
    On Error GoTo 0
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!