Copia dati

Hai un problema con Excel?

Nuova discussione

Copia dati
di andrea (utente non iscritto) data: 02/06/2016 14:10:37
Buongiorno a tutti. Devo preparare una ricerca epidemiologica relativa al peso corporeo dei miei assistiti. Per fare questo devo utilizzare le schede di visita, una per ciascun paziente: ogni scheda è un file di Excel (i file stanno nella stessa cartella), in cui ho le seguenti corrispondenze:

Foglio1, B3 = Sesso (Maschile, Femminile)
Foglio1, C5 = Data di nascita
Foglio1, D12 = Città
Foglio3, D27 = Altezza
Foglio3, G27 = Peso corporeo

I file di Excel sono circa 1000. Vorrei riportare i dati sopra indicati in un file (che allego alla presente). Esiste qualche modo per farlo automaticamente?? Vi ringrazio anticipatamente.
di Albatros54 data: 02/06/2016 18:07:27
Puoi adattare questo codice alle tue esigenze
Ciao
albatros54
h t t p ://www.excelvba.it/Forum/thread.php?f=2&t=10651
di andrea (utente non iscritto) data: 02/06/2016 18:45:11
Il link che mi indichi non mi dà nessun risultato.
di andrea (utente non iscritto) data: 02/06/2016 18:52:00
Ho trovato la discussione alla quale facevi riferimento; sinceramente non saprei da che parte cominciare per adattare la macro al mio caso. Avrei proprio bisogno di un aiuto.
di patel data: 03/06/2016 08:17:43
allega una cartella con 3 file da cui prelevare i dati
di andrea (utente non iscritto) data: 04/06/2016 13:35:35
Allego i tre file di esempio; alcuni dati da prelevare si trovano nel foglio1 (Anagrafe), altri nel foglio2(Peso). I dati da prelevare sono quelli relatici a:
Sesso (maschile o femminile), sul Foglio Anagrafe
Data di nascita, sula foglio Anagrafe
Città di residenza, sul foglio Anagrafe
Altezza, sul foglio Peso
Peso, sul foglio Peso.

Grazie.

di Albatros54 data: 04/06/2016 13:56:03
prova questo codice.
PS. il file Excel Peso si deve trovare fuori dalla dir "nuova cartella"
ciao
albatros54

Public Sub copia()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim wk As Workbook
    Dim r As Long

    With Application
        .ScreenUpdating = False
    End With
    sPath = ThisWorkbook.Path & "
uova cartella"    '<< da Modificare
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)
    r = 3
    For Each objFile In objFolder.Files
        MyName = Dir(objFile, vbNormal)
        If MyName <> ThisWorkbook.Name Then
            Set wk = Workbooks.Open(objFile.Path)
            sesso = wk.Sheets("anagrafe").Range("f3")
            nascita = wk.Sheets("anagrafe").Range("b4")
            residenza = wk.Sheets("anagrafe").Range("b5")
            altezza = wk.Sheets("peso").Range("b3")
            peso = wk.Sheets("peso").Range("d3")
            nome = wk.Name
            wk.Close Savechanges:=False
            irow = ThisWorkbook.Sheets("foglio1").Range("a" & Rows.Count).End(xlUp).Row + 1
            Cells(irow, 1) = sesso
            Cells(irow, 2) = residenza
            Cells(irow, 3) = nascita
            Cells(irow, 4) = altezza
            Cells(irow, 5) = peso
            Set wk = Nothing

        End If
    Next

    With Application
        .ScreenUpdating = True
    End With
    Set wk = Nothing
    Set sh = Nothing
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing

End Sub

di andrea (utente non iscritto) data: 04/06/2016 16:46:11
Grazie!! Mi sembra che funzioni. Appena posso provo sulla cartella che contiene i file reali.

Vuoi Approfondire?