Informazioni: postmaster@valcos47.it

Sub CopiaDatiSuFileEsterno() 'Variabili Dim wbInterfaccia As Workbook Dim wbEsterno As Workbook Dim wsInterfaccia As Worksheet Dim wsEsterno As Worksheet Dim tabellaInterfaccia As ListObject Dim tabellaEsterno As ListObject Dim filePercorsoEsterno As String Dim directoryEsterno As String Dim rngOrigine As Range Dim rngDestinazione As Range ' Definisci il percorso del file esterno (disco esterno) directoryEsterno = "F:\Base1\" ' Sostituire con il percorso corretto filePercorsoEsterno = directoryEsterno & "FileEsterno.xlsx" ' Nome del file esterno ' Apri il file esterno On Error GoTo ErroreApertura Set wbEsterno = Workbooks.Open(Filename:=filePercorsoEsterno) On Error GoTo 0 ' Se il file esterno è aperto correttamente If Not wbEsterno Is Nothing Then ' Ottieni il file di interfaccia Set wbInterfaccia = ThisWorkbook ' Verifica che il foglio di lavoro di interfaccia esista On Error Resume Next Set wsInterfaccia = wbInterfaccia.Sheets(2) ' Primo foglio del file di interfaccia On Error GoTo 0 If wsInterfaccia Is Nothing Then MsgBox "Il foglio di lavoro nel file di interfaccia non esiste!", vbCritical Exit Sub End If ' Ottieni o crea la tabella nel foglio di lavoro del file di interfaccia On Error Resume Next Set tabellaInterfaccia = wsInterfaccia.ListObjects("TabellaDati") On Error GoTo 0 ' Se la tabella "TabellaDati" non esiste, creala If tabellaInterfaccia Is Nothing Then ' Definisci l'intervallo in cui creare la tabella Set rngOrigine = wsInterfaccia.Range("A1:p20") ' Modifica l'intervallo in base alle tue esigenze With rnOrigine .Add.Sheets.Name = Year(Date) & "_" & Month(Date) & "_" & Day(Date) & "_" & Hour(Time) & "_" & Minute(Time) End With ' Crea la tabella Set tabellaInterfaccia = wsInterfaccia.ListObjects.Add(xlSrcRange, rngOrigine, , xlYes) tabellaInterfaccia.Name = "TabellaDati" ' Aggiungi intestazioni (opzionale) wsInterfaccia.Range("A1").Value = "Dato 1" wsInterfaccia.Range("B1").Value = "Dato 2" MsgBox "La tabella 'TabellaDati' è stata creata nel foglio di interfaccia.", vbInformation End If ' Ottieni il foglio di lavoro del file esterno On Error Resume Next Set wsEsterno = wbEsterno.Add.Sheets("Risultati") ' Prova a ottenere il foglio On Error GoTo 0 ' Se il foglio "Risultati" non esiste, crealo If wsEsterno Is Nothing Then Set wsEsterno = wbEsterno.Sheets.Add wsEsterno.Name = Year(Date) & "_" & Month(Date) & "_" & Day(Date) & "_" & Hour(Time) & "_" & Minute(Time) End If ' Verifica se la tabella esiste nel foglio "Risultati" On Error Resume Next Set tabellaEsterno = wsEsterno.ListObjects("TabellaRisultati") On Error GoTo 0 ' Se la tabella "TabellaRisultati" non esiste, creala If tabellaEsterno Is Nothing Then Set rngDestinazione = wsEsterno.Range("A1:p20") Set tabellaEsterno = wsEsterno.ListObjects.Add(xlSrcRange, rngDestinazione, , xlYes) tabellaEsterno.Name = "TabellaRisultati" End If ' Copia i dati dalla tabella del file di interfaccia a quella del file esterno Set rngOrigine = tabellaInterfaccia.DataBodyRange Set rngDestinazione = tabellaEsterno.DataBodyRange ' Cancella i vecchi dati nella tabella esterna If Not rngDestinazione Is Nothing Then rngDestinazione.Clear End If ' Copia i nuovi dati rngOrigine.Copy Destination:=tabellaEsterno.Range(2, 1) ' Salva il file esterno wbEsterno.Save ' Chiudi il file esterno wbEsterno.Close MsgBox "Copia dei dati completata con successo!", vbInformation End If Exit Sub ErroreApertura: MsgBox "Errore nell'apertura del file esterno. Controlla che il percorso sia corretto o che il file non sia già aperto.", vbCritical End Sub

Routine per copiare una tabella su file esterno

INIZIO Chi sono Home
Notifica sui cookie