Export dati

Hai un problema con Excel?

Nuova discussione

Export dati
di kyes (utente non iscritto) data: 25/10/2017 22:28:54
Buonasera a tutto il forum, sono un appassionato di VBA alle prime armi ed avrei bisogno di aiuto.
Il problema è il seguente,
ho più file Excel contenenti vari fogli di lavoro, fra cui quelli che mi interessano chiamati EXPEDITOR di 150 righe ciascuno in una stessa cartella,
quello che vorrei fare è copiare tutti i dati nei fogli chiamati EXPEDITOR dei vari file excel in un unico file di un solo foglio di lavoro che chiameremo TRACKER, ovviamente i dati del primo file EXPEDITOR saranno copiati nelle righe da 1 a 150 del TRACKER, il secondo nelle righe da 151 a 301 e via discorrendo fino a copiare tutti i file della cartella senza sovrapporli.
Scopiazzando qua e la ne ho trovati a bizzeffe di codici che copiano da un Excel all'altro ma tutti ripartono a copiare dalla riga A1 sovrascrivendo i dati come nell'esempio che allego, ho provato a modificarli con vari stratagemmi fra cui degli inputbox ma senza riuscirvi, non sono mai riuscito a ripartire nella copia dalla riga 151 in poi.
Spero di aver esposto chiaramente il mio problema, ringrazio in anticipo chi vorrà aiutarmi.

Sub copy_data()
Dim f As Object, wbk1 As Workbook, wbk2 As Workbook, rg As Long, col As Long, area As Range

    Application.ScreenUpdating = False
    Set wbk1 = ThisWorkbook
    For Each f In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "").Files
        If Left(f.Name, 1) <> "~" And (Right(f.Name, Len(f.Name) - InStrRev(f.Name, ".")) Like "*xl*") And (f.Name <> ThisWorkbook.Name) Then
            Set wbk2 = Workbooks.Open(f)
            rg = rg + 1
            col = 0
             With wbk2.Sheets("foglio1")
             rw = wbk1.Sheets("foglio1").Range("A" & .Rows.Count).End(xlUp).Row
              .Range("a1").CurrentRegion.Copy wbk1.Sheets("foglio1").Cells(rw, 1)
              
              End With
            wbk2.Close False
        End If
    Next
    Application.ScreenUpdating = True
End Sub

di patel data: 26/10/2017 07:50:08
ho provato il codice allegato, non copia sempre sulla prima riga, basta una piccola modifica
.Range("a1").CurrentRegion.Copy wbk1.Sheets("foglio1").Cells(rw+1, 1)

le righe
rg = rg + 1
col = 0
sono inutili

di kyes (utente non iscritto) data: 27/10/2017 16:51:19
Grazie infinite ero veramente molto vicino ma non sarei riuscito a scovare l'inghippo, ancora una cosa se posso, il codice nuovo creato mi copia anche le formule del foglio DETAILS, se volessi fare un copia del solo testo senza le formule?

Sub copy_data_2()
Dim f As Object, wbk1 As Workbook, wbk2 As Workbook, rg As Long, col As Long, area As Range
Application.ScreenUpdating = False
    Set wbk1 = ThisWorkbook
    For Each f In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "").Files
        If Left(f.Name, 1) <> "~" And (Right(f.Name, Len(f.Name) - InStrRev(f.Name, ".")) Like "*xl*") And (f.Name <> ThisWorkbook.Name) Then
            Set wbk2 = Workbooks.Open(f)
           With wbk2.Sheets("DETAILS")
             rw = wbk1.Sheets("TRACKER").Range("A" & .Rows.Count).End(xlUp).Row
              .Range("a1").CurrentRegion.Copy wbk1.Sheets("TRACKER").Cells(rw + 1, 1)
              End With
            wbk2.Close False
        End If
    Next
    Application.ScreenUpdating = True
End Sub

di Albatros54 data: 27/10/2017 19:16:56
vedi se ti puo essre utile
h t t p ://www.excelvba.it/Forum/thread.php?f=1&t=12394
di kyes data: 29/10/2017 12:23:32
Grazie comunque per la dritta Albatros54 ma non sono riuscito a capire come adattare la differenza fra il tuo consiglio ed il codice che uso....scusami, potresti spiegarlo come ad un bambino di 5 anni?
Grazie in anticipo
di patel data: 30/10/2017 09:28:25
se vuoi copiare solo i valori e non sai come fare attiva il registratore di macro, copia un renge e fai incolla valori su una cella, ferma il registratore e controlla il codice
di kyes data: 31/10/2017 19:46:06
ok....messaggio ricevuto grazie per il supporto

Vuoi Approfondire?