MACRO CONSOLIDA CSV

Versione Completa Stampa Cerca Utenti Iscriviti Condividi :

Excel Forum » Excel Forum » » Soluzioni Excel Domande e Risposte

Tommy.ExcelForum

00venerdì 10 giugno 2016 15:57

Ciao ragazzi,

qualche anima pia mi aiuterebbe a creare una semplice macro che mi copia tutti i csv presenti in una cartella su un unico foglio.

MI piacerebbe che la macro:

- selezionasse come percorso di ricerca quello in cui sarà presente il foglio di consolidamento

- che ogni csv venisse aperto copiato e incollato su un nuovo foglio ed in fine il foglio rinominato con il nome del csv

- questo fino a quando trova csv nella cartella.

(se può esser utile saperlo i csv sono nominati 101,102,103 e via dicendo fino ad un max di 199, ma alcuni numeri non sono presenti)

100000 grazie e punti stima a chi si cimenterà :)

patel45

00venerdì 10 giugno 2016 17:14

tutti i csv hanno la stessa struttura ? allegane uno

Tommy.ExcelForum

00lunedì 13 giugno 2016 16:05

Ciao Patel,

I csv hanno tutti formato identico ma nr variabile di righe.
(csv-ms dos, separato da punto e virgola).

Questa barbara scrittura che ho fatto col registra macro funziona allo scopo ma vorrei evitare di riscrivere 30 righe ad ogni foglio che aggiungo o tolgo e far in modo che passi in rassegna da solo tt i file della cartella.

Dim stingpath As String
Dim csv1 As String

StringPath = Application.ActiveWorkbook.Path
csv1 = 101
csv2 = 102
csv3 = 103
'(...)

Path = StringPath & "\" & csv1 'creo stringa file da aprire

Workbooks.Open Filename:=Path, Local:=True 'apro csv
Range(Selection, Selection.End(xlToRight)).Select 'copio dati
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ThisWorkbook.Activate 'torno
Sheets("101").Select 'destinazione
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'incollo
Workbooks.Open Filename:=Path, Local:=True
ActiveWindow.Close 'chiudo

grazie mille per la disponibilità.

patel45

00lunedì 13 giugno 2016 18:01

non hai allegato il file come richiesto
la macro la devo testare

Tommy.ExcelForum

00lunedì 13 giugno 2016 18:34

Scusa, non l'ho fatto volutamente in quanto dati sensibili.

ti propongo una riga per poterci intendere, grazie!

il file arriva anche a 300.000 righe.

51296047;IT152-1;2;01.04.16;18:29:23;5204;100000;2;4;16

patel45

00lunedì 13 giugno 2016 19:06

ovviamente non testato

 
Sub csvimport()

On Error GoTo RigaErrore
 
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim sPath As String
     
    With Application
        .ScreenUpdating = False
    End With
     
    sPath = "C:\cartella\" ' deve finire per \
     
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)
 

    For Each objFile In objFolder.Files
        If Right(objFile.Name, 3) = "csv" Then
            ThisWorkbook.Worksheets.Add
            ActiveSheet.Name = objFile.Name
        
           With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPath & objFile.Name, _
                Destination:=Range("A1"))
                .Name = "Cartel2"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 1250
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = True  '<<===Delimitatore
                .TextFileCommaDelimiter = False  '<<===Delimitatore
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1,1,1,1,1,1,1,1,1,1) '<<=== Numero colonne da modificare
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
        End If
     Next
     
RigaChiusura:
     Set objFile = Nothing
     Set objFolder = Nothing
     Set objFSO = Nothing
     With Application
         .ScreenUpdating = True
     End With
     Exit Sub
    
RigaErrore:
     MsgBox Err.Number & vbNewLine & Err.Description
     Resume RigaChiusura
 
End Sub

Tommy.ExcelForum

00martedì 14 giugno 2016 15:56

Funziona alla grande!!!!!
1 milione di grazie Patel!

andrea_c.ExcelForum

00venerdì 24 febbraio 2017 11:46

Buongiorno,

ho un problema molto simile e mi chiedevo se cortesemente poteste aiutare anche me! :)
nello specifico mi trovo a gestire un database in cui riporto i dati presenti in file (tutti con lo stesso format). I dati che vado a riportare nel database sono sempre nelle stesse celle dei vari file.

Ciò a cui vorrei arrivare è un database nel quale in una colonna scrivo il nome del file da cui attingere e in automatico, tramite macro, mi compilasse il database con i valori di mio interesse.

Grazie in anticipo per l'aiuto!

Andrea

Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa clicca qui
Tutti gli orari sono GMT+01:00. Adesso sono le 17:57.