Exel使用宏在3个工作表中导入3个xls

Question

我想将数据从3个不同的.xls文件导入到3个特定的工作表。

我已经有了一个包含以下脚本的用户表单：

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

我想使用子"Generate_Database(SelectedFile)“将3个文件中的数据放到3个不同的工作表中，但我不知道如何开始。

如果有人能帮我，我会很高兴的..

问候:)

Answer 1

请尝试下一个代码：

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