Copiare contenuto files tramite VBA

Question

Ciao a tutti,

ho una serie di file Excel con struttura identica (sono ordini), cambiano solo il nome del file e, ovviamente, il contenuto.

Tramite:

Dim MyPath As String

Dim FileName As String

MyPath = "c:\path\*.xlsm"

FileName = Dir(MyPath)

Do While FileName <> ""

    MsgBox FileName

    FileName = Dir

Loop

Trovo il nome esatto di tutti questi file, ma come faccio a copiare il contenuto di alcune celle nel file dal quale lancio la macro?

Vorrei poter avere in un foglio un elenco di alcuni dei dati contenuti in tutti i fogli Excel presenti nella cartella

Grazie mille!!!

P.

Answer 1

Ciao a tutti,

ho una serie di file Excel con struttura identica (sono ordini), cambiano solo il nome del file e, ovviamente, il contenuto.

Tramite:

Dim MyPath As String

Dim FileName As String

MyPath = "c:\path\*.xlsm"

FileName = Dir(MyPath)

Do While FileName <> ""

    MsgBox FileName

    FileName = Dir

Loop

Trovo il nome esatto di tutti questi file, ma come faccio a copiare il contenuto di alcune celle nel file dal quale lancio la macro?

Vorrei poter avere in un foglio un elenco di alcuni dei dati contenuti in tutti i fogli Excel presenti nella cartella

Grazie mille!!!

P.

Bene o male è una cosa che abbiamo trattato n volte qui sul forum. Mettiamo tu abbia i tuoi files in C:\miaCartella e i dati nei vari Fogli1 colonne A:C. Questo codice nel file dove vuoi recuperare *tutti* i dati:

Public Sub m()

On Error GoTo RigaErrore

    Dim objFSO As Object

    Dim objFolder As Object

    Dim objFile As Object

    Dim shMe As Worksheet

    Dim sh As Worksheet

    Dim sPath As String

    Dim sRange As String

    Dim wk As Workbook

    Dim lRigaMe As Long

    Dim lRiga As Long

    sPath = "C:\miaCartella"

    Set shMe = ThisWorkbook.Worksheets("Foglio1")

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFolder = objFSO.GetFolder(sPath)

    With shMe

        .Cells.Clear

        Application.DisplayAlerts = False

        For Each objFile In objFolder.Files

            lRiga = 0

            lRigaMe = .Range("A" & .Rows.Count).End(xlUp).Row

            Set wk = Workbooks.Open(sPath & "" & objFile.Name)

            Set sh = wk.Worksheets("Foglio1")

            lRiga = sh.Range("A" & .Rows.Count).End(xlUp).Row

            sh.Range("A1:C" & lRiga).Copy

            .Range("A" & lRigaMe + 1).PasteSpecial

            wk.Save

            wk.Close

        Next

        Application.DisplayAlerts = True

    End With

RigaChiusura:

    Set sh = Nothing

    Set shMe = Nothing

    Set wk = Nothing

    Set objFile = Nothing

    Set objFolder = Nothing

    Set objFSO = Nothing

    Exit Sub

RigaErrore:

    MsgBox Err.Number & vbNewLine & Err.Description

    Resume RigaChiusura

End Sub

E' banale a questo punto estrapolare solo alcune celle azichè tutta la tabella. Prova un po' e fai sapere, grazie.