Macro VBA per copiare i dati da un file excel ad un altro

Ho 2 Excel cartelle di lavoro. Entrambi sono in cartelle diverse.
Io sono la copia di dati da una all’altra con un macro.

Osservo un indice non incluso nell’intervallo di errore…

Intuizioni in questo ?

Ecco il mio codice

Sub copydata()
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shttocopy As Worksheet
Dim wbname As String

' check if the file is open 
ret = Isworkbookopen("C:\file1.xlsx") 
If ret = False Then
' open file
Set wkbSource = Workbooks.Open("C:\file1.xlsx")
Else
'Just make it active
 Workbooks("C:\file1.xlsx").Activate
 End If

' check if the file is open 

ret = Isworkbookopen("C:\File2.xlsx")
If ret = False Then
' open file
Set wkbDest = Workbooks.Open("C:\file2.xlsx")
Else
'Just make it active
 Workbooks("file2.xlsx").Activate

End If

'perform copy
Set shttocopy = wkbSource.Sheets("filedata")
shttocopy.Copy wkbDest.Sheets(3)

End Sub

Function Isworkbookopen(filename As String)
Dim ff As Long, ErrNo As Long
Dim wkb As Workbook
Dim nam As String

wbname = filename
On Error Resume Next

ff = FreeFile()
Open filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: Isworkbookopen = False
Case 70: Isworkbookopen = True
Case Else: Error ErrNo
End Select

End Function
  • Il wkbDest Cartella di lavoro hanno sicuramente un Worksheet con indice = 3?
  • Sì, è corretto
  • La riga che causa il subscript out of range di errore?
  • Le Cartelle Di Lavoro(“C:\file1.xlsx”).Attivare e Cartelle di lavoro(“file2.xlsx”).Attivare. (Io sono scrittura e l’esecuzione di questa macro nel file1.xlsx)
  • Oh, può essere necessario il percorso completo del file c’ (piuttosto che solo il nome del file)
  • Aggiunto il percorso completo ancora un errore in questa riga : Workbooks(“C:\file1.xlsx”).Attivare
  • Io sono la scrittura e l’esecuzione di questa macro nel file2 e non in file1.xlsx
  • Grazie Dan! il codice ha funzionato perfettamente 🙂
  • Wow — entrambi abbiamo imparato qualcosa c’è!!!
  • Totalmente d’accordo:)



One Reply
  1. 5

    OK, credo di avere capito. Invece di .Activate, ti basta impostare il libro se è già aperto. Faremo anche riferimento al libro di il nome del file, NON il percorso (come avevo erroneamente suggerito in un commento precedente).

    Questo ha funzionato per me:

    Sub copydata()
    Dim wkbSource As Workbook
    Dim wkbDest As Workbook
    Dim shttocopy As Worksheet
    Dim wbname As String
    
    ' check if the file is open
    ret = Isworkbookopen("C:\stack\file1.xlsx")
    If ret = False Then
    ' open file
    Set wkbSource = Workbooks.Open("C:\stack\file1.xlsx")
    Else
    'Just make it active
     'Workbooks("C:\stack\file1.xlsx").Activate
     Set wkbSource = Workbooks("file1.xlsx")
     End If
    
    ' check if the file is open
    
    ret = Isworkbookopen("C:\stack\File2.xlsx")
    If ret = False Then
    ' open file
    Set wkbDest = Workbooks.Open("C:\stack\file2.xlsx")
    Else
    'Just make it active
     'Workbooks("C:\stack\file2.xlsx").Activate
     Set wkbDest = Workbooks("file2.xlsx")
    
    End If
    
    'perform copy
    Set shttocopy = wkbSource.Sheets("filedata")
    shttocopy.Copy wkbDest.Sheets(3)
    
    End Sub
    
    Function Isworkbookopen(filename As String)
    Dim ff As Long, ErrNo As Long
    Dim wkb As Workbook
    Dim nam As String
    
    wbname = filename
    On Error Resume Next
    
    ff = FreeFile()
    Open filename For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0
    Select Case ErrNo
    Case 0: Isworkbookopen = False
    Case 70: Isworkbookopen = True
    Case Else: Error ErrNo
    End Select
    
    End Function

Lascia un commento