help needed: choose files and merge them

[akos084]

Hi,

I have the following problem:
User has to choose files and want to populate a database using the firs sheet of each file.

i have a working code, however I am not satisfied with it:

Private Sub PopulateDatabase_Click()

    'Dim TBMDataSource As String
    
    'Dim GeoTBMDataSource As String

    WorkbookName = ThisWorkbook.Name

    'wanted to use variables, but not working
    
    'set TBMDataSource = TBMData.Value

    'set GeoDatasource = GeoData.Value
    
    'delete existing datasheets and create new empty ones

    Dim sh As Worksheet, flg As Boolean
    
    For Each sh In Worksheets
    If sh.Name Like "TBM Database" Then flg = True: Exit For
        Next
    
    If flg = True Then
        Application.DisplayAlerts = False
            Sheets("TBM Database").Delete
        Application.DisplayAlerts = True
    End If

    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "TBM Database"

    For Each sh In Worksheets
    If sh.Name Like "Geo Database" Then flg = True: Exit For
        Next
    
    If flg = True Then
        Application.DisplayAlerts = False
            Sheets("Geo Database").Delete
        Application.DisplayAlerts = True
    End If
    
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Geo Database"
    
    'open files and copy data

    Application.DisplayAlerts = False
    
    Set TBMDataSource = Application.Workbooks.Open(TBMData.Value)
    
    Sheets("Sheet1").UsedRange.Copy
    
    Workbooks(WorkbookName).Sheets("TBM Database").Activate
    
    ActiveSheet.Paste
    
    TBMDataSource.Close savechanges:=False
    
    Set GeoDataSource = Application.Workbooks.Open(GeoData.Value)
    
    Sheets("Sheet1").UsedRange.Copy
    
    Workbooks(WorkbookName).Sheets("TBM Database").Activate
    
    ActiveSheet.Paste
    
    GeoDataSource.Close savechanges:=False
 
    Application.DisplayAlerts = True
    
    
End Sub

Sub GetGeoData_click()
    
    Dim SourceFile As String
        
    SourceFile = Application.GetOpenFilename
    
    GeoData.Value = SourceFile
   
End Sub

Sub GetTBMData_click()
    
    Dim SourceFile As String
        
    SourceFile = Application.GetOpenFilename
    
    TBMData.Value = SourceFile
    
End Sub

what I would like to do is have a function to open files with the attributes of output TextBox. Cannot do it as I could not write TextBox from a function. Is there a way around?

This following code is ugly, but works. It opens a files, select all data from the sheet, activates the new worksheet and copies the data. There should be a way to copy entire sheets easier, but I could not make it work. Any ideas?

Can it be done using a function or sub with the arguments "source file name" " source sheet", and "Destination file name", "destination sheet"?

    Set TBMDataSource = Application.Workbooks.Open(TBMData.Value)
    
    Sheets("Sheet1").UsedRange.Copy
    
    Workbooks(WorkbookName).Sheets("TBM Database").Activate
    
    ActiveSheet.Paste
    
    TBMDataSource.Close savechanges:=False

Thank you in advance for the ideas!

[patel45]

Put filenames in column A starting from A3 and run this macro

Option Base 1
Sub Open_files()
Dim FILETOOPEN()
Dim Iname
UR = Range("A3").End(xlDown).Row

FILETOOPEN = Range(("A3:A" & UR)).Value

For i = 1 To UBound(FILETOOPEN)

    Iname = FILETOOPEN(i)
    Workbooks.Open Filename:=Iname
    .......... put your code
Next i
End Sub