Ciao a tutti,
sono nuova di questo forum, spero che possiate darmi una mano.
Ho un certo numero di files excel (il numero dei files cambia di giorno in giorno) e devo fonderli in un unico file.
Vi incollo il codice che ho scritto:


codice:
Sub LoadFiles()
    Dim YourFileSpec As String
    Dim YourDirectory As String
    Dim LoadDirFileList As Variant
    Dim ActiveFile As String
    Dim FileCounter As Integer
    Dim NewWb As Workbook
     
    YourDirectory = "C:\Temp\"
    YourFileSpec = "*.xls"
    yourFile = YourDirectory & YourFileSpec
    LoadDirFileList = GetFileList(YourDirectory & YourFileSpec)
    
    'Se non trova nessun file esce dalla funzione
    
    If IsArray(LoadDirFileList) = False Then
        MsgBox "No files found"
        Exit Sub
    Else
         ' Loop around each file in your directory
        For FileCounter = LBound(LoadDirFileList) To UBound(LoadDirFileList)
            ActiveFile = LoadDirFileList(FileCounter)
            Set NewWb = Workbooks.Open(YourDirectory & ActiveFile)
            
            ' put code here to copy whatever range you want to your workbook
            
     '    NewWb.Worksheets("Sheet1").Range("A1:D10").Copy
         NewWb.Worksheets("Sheet1").Range("A1:I100").Copy
         ThisWorkbook.Worksheets("sheet1").Range("A65536").End(xlUp).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
          
            
            NewWb.Close
            Set NewWb = Nothing
        Next FileCounter
    End If
End Sub
  
 
Function GetFileList(FileSpec As String) As Variant
     ' Author : Carl Mackinder (From JWalk)
     ' Last Update : 25/05/06
     ' Returns an array of filenames that match FileSpec
     '   If no matching files are found, it returns False
     
    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String
     
    On Error GoTo NoFilesFound
     
    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
     
     '   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function
     
NoFilesFound:
    GetFileList = False
End Function
Mi va in errore su questa riga:

ThisWorkbook.Worksheets("sheet1").Range("A65536"). End(xlUp).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

(errore di run time 9)... potete aiuarmi?

mary