Macro unisci file cvs e salta prima riga

Question

Buonasera a tutti,

grazie alla rete son riuscito a creare una macro che unisce tutti i files *csv presenti nella cartella dove risiede il file Excel a cui è assegnata la macro stessa.

Premesso che i files cvs hanno tutti la medesima riga di intestazione vorrei evitare che questa venga importata tante volte quanti sono i files da importare.

Come dovrei modificare il mio codice?

Grazie anticipatamente

Stefano

Questo il codice

Sub UnisciCSV()

  Dim FName As Variant, R As Long, AppPath As String

  R = 1

  AppPath = Application.ActiveWorkbook.Path & ""

  FName = Dir(Application.ActiveWorkbook.Path & "" & "*.csv")

  Do While FName <> ""

    ImportaCsvFile AppPath & FName, ActiveSheet.Cells(R, 1)

    R = ActiveSheet.UsedRange.Rows.Count + 1

    FName = Dir

  Loop

End Sub

Sub ImportaCsvFile(FileName As Variant, Position As Range)

  With ActiveSheet.QueryTables.Add(Connection:= _

      "TEXT;" & FileName _

      , Destination:=Position)

      .Name = Replace(FileName, ".csv", "")

      .FieldNames = True

      .RowNumbers = False

      .FillAdjacentFormulas = False

      .RefreshOnFileOpen = False

      .BackgroundQuery = True

      .RefreshStyle = xlInsertDeleteCells

      .SavePassword = False

      .SaveData = True

      .AdjustColumnWidth = True

      .TextFilePromptOnRefresh = False

      .TextFilePlatform = 850

      .TextFileStartRow = 1

      .TextFileParseType = xlDelimited

      .TextFileTextQualifier = xlTextQualifierDoubleQuote

      .TextFileConsecutiveDelimiter = False

      .TextFileTabDelimiter = True

      .TextFileSemicolonDelimiter = False

      .TextFileCommaDelimiter = False

      .TextFileSpaceDelimiter = False

      .TextFileOtherDelimiter = ";"

      .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _

        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _

        , 1, 1)

      .Refresh BackgroundQuery:=False

  End With

End Sub

Answer 1

Ciao Stefano,

Prova a sostituire il codice della procedura UnisciCSV con la seguente versione:

'=========>>

Option Explicit

'--------->>

Public Sub UnisciCSV()

    Dim FName As Variant

    Dim R As Long, i As Long

    Dim AppPath As String

    R = 1

    AppPath = Application.ActiveWorkbook.Path & " \ "

    FName = Dir(AppPath & "*.csv")

    Do While FName <> ""

  i = i + 1

        ImportaCsvFile AppPath & FName, ActiveSheet.Cells(R, 1)

        If i > 1 Then

ActiveSheet.Rows(R).Delete

End If

        R = ActiveSheet.UsedRange.Rows.Count + 1

        FName = Dir

    Loop

End Sub

'<<=========

Le modifiche sono evidenziate in grassetto.

===

Regards,

Norman

Answer 2

Ciao Mauro,

Fatto.

Sempre diligente! 

Grazie!

===

Regards,

Norman

Answer 3

Fatto.

Ciao.

Answer 4

Ciao Stefano,

Mi fa piacere che hai risolto il problema e ti ringrazio per il cortese riscontro.

Per chiudere questo thread, vorrei chiederti gentilmente di contrasegnare la mia risposta come Risposta preferita. In questo modo, tu aiuterai anche coloro che potessero cercare soluzioni ai problemi simili negli archivi della Community.

===

Regards,

Norman

Answer 5

Ho apportato le modifiche suggerite ed il tutto va che una meraviglia.

Grazie infinite

Questo il codice corretto:

Sub UnisciCSV()

  Dim FName As Variant, R As Long, i As Long, AppPath As String

  R = 1

  AppPath = Application.ActiveWorkbook.Path & ""

  FName = Dir(Application.ActiveWorkbook.Path & "" & "*.csv")

  Do While FName <> ""

    i = i + 1

    ImportaCsvFile AppPath & FName, ActiveSheet.Cells(R, 1)

    If i > 1 Then

            ActiveSheet.Rows(R).Delete

        End If

    R = ActiveSheet.UsedRange.Rows.Count + 1

    FName = Dir

  Loop

End Sub

Sub ImportaCsvFile(FileName As Variant, Position As Range)

  With ActiveSheet.QueryTables.Add(Connection:= _

      "TEXT;" & FileName _

      , Destination:=Position)

      .Name = Replace(FileName, ".csv", "")

      .FieldNames = True

      .RowNumbers = False

      .FillAdjacentFormulas = False

      .RefreshOnFileOpen = False

      .BackgroundQuery = True

      .RefreshStyle = xlInsertDeleteCells

      .SavePassword = False

      .SaveData = True

      .AdjustColumnWidth = True

      .TextFilePromptOnRefresh = False

      .TextFilePlatform = 850

      .TextFileStartRow = 1

      .TextFileParseType = xlDelimited

      .TextFileTextQualifier = xlTextQualifierDoubleQuote

      .TextFileConsecutiveDelimiter = False

      .TextFileTabDelimiter = True

      .TextFileSemicolonDelimiter = False

      .TextFileCommaDelimiter = False

      .TextFileSpaceDelimiter = False

      .TextFileOtherDelimiter = ";"

      .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _

        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _

        , 1, 1)

      .Refresh BackgroundQuery:=False

  End With

End Su