i want to import the data from 3 different .xls files into 3 specific Worksheets.

I already have a Userform with following script:

Private Sub Button_SelectFile_Click()
    
    SelectedFile = Application.GetOpenFilename(fileFilter:="Excel-Dateien (*.xls; *.xlsm; *.xlsx),*.xls; *.xlsm; *.xlsx", Title:="Bitte SAP-Export-Datei auswählen", MultiSelect:=True)
    
    If VarType(SelectedFile) = vbBoolean Then
        If SelectedFile = False Then
            Auswertung.Label_SelectedFile.Caption = "Ausgewählte Dateien: Keine"
            Exit Sub
        End If
    Else
        Auswertung.Label_SelectedFile.Caption = "Ausgewählte Dateien: " & Join(SelectedFile, "; ")
    End If
End Sub

Private Sub Button_Start_Click()
     
    Dim Box
    
    If VarType(SelectedFile) = vbEmpty Then
        Box = MsgBox("Bitte wählen Sie mindestens eine Datei aus.", vbOKOnly, "Keine Datei ausgewählt")
        If Box = vbOK Then
            Exit Sub
        End If

    Else
        Box = MsgBox("Möchten Sie das Programm starten?", vbOKCancel)
        If Box = vbOK Then
            'Starten'
            Call Generate_Database(SelectedFile)
        Else
            Exit Sub
        End If
    End If
    
End Sub

I wanted to use the Sub "Generate_Database(SelectedFile)" for getting the data from the 3 files into the 3 different sheets but I am not quiet shure how to start.

If someone could help me out it would make my day..

Greetings :)

CodePudding user response：

Please, try the next code:

Sub Generate_Database(arrWb As Variant)
   Dim El, wb As Workbook, wbCopy As Workbook
   Dim shP As Worksheet, shName As String, arrC
   
   If Not IsArray(arrWb) Then Exit Sub
   If UBound(arrWb) > 3 Then MsgBox _
          "Too many workbooks selected (" & UBound(arrWb)   1 & ") instead of maximum 3...": Exit Sub
   Set wb = ThisWorkbook

   For Each El In arrWb
        Set wbCopy = Workbooks.Open(El)
        shName = Split(Right(El, Len(El) - InStrRev(El, "\")), ".")(0) 'extract the sheet name from wb name
        arrC = wbCopy.Sheets(1).UsedRange.Value
        On Error Resume Next
         Set shP = ThisWorkbook.Sheets(shName)
         If err Then
            err.Clear: On Error GoTo 0
            MsgBox "Not possible to find the sheet named " & shName & "...": Exit Sub
         End If
        On Error GoTo 0
        With shP.Range("A1").Resize(UBound(arrC), UBound(arrC, 2))
                .Value = arrC
                .EntireColumn.AutoFit
        End With
        wbCopy.Close False
   Next
End Sub