时间戳

首页 > 解决方案 > 从两个工作簿复制到两个工作表

excel - 从两个工作簿复制到两个工作表

问题描述

我有一个文件夹，其中存储了两种类型的工作簿，它们是[person_name]-RESUME.xlsx和 [person_name].xlsx. 使用我的代码，用户可以选择这两个文件。

我希望单击工作簿上的按钮，选择这两个文件，将内容复制[person_name]-RESUME.xlsx到 sheet1 并将内容复制[person_name].xlsx到 sheet2，然后关闭这两个文件。

使用我的代码时出现错误Run-time error '91': Object variable or With block variable not set，当我单击“调试”时，它会突出显示ElseIf我的函数，我已经尝试打开单个文件的函数代码，它工作正常。贝娄是我的代码。

Sub opening_multiple_file()

    Dim i As Integer
    Dim myrange As Range
    Dim n_rows_A As Long, n_rows_B As Long, n_rows As Long
    'Opening File dialog box
    With Application.FileDialog(msoFileDialogFilePicker)
    
        'Enabling multiple files select
        .AllowMultiSelect = True
        .Filters.Clear
        
        'Only Excel files can be selected
        .Filters.Add "Excel Files", "*.xls*"
        
        If .Show = True Then
            For i = 1 To .SelectedItems.Count
                'Opening selected file
                Workbooks.Open .SelectedItems(i)
                
                'Check if file is a resume
                If InStr(.SelectedItems(i), "-RESUME") Then
                    
                    n_rows_A = CountRows(myrange)
                    n_rows_B = CountRows(myrange.Offset(0, 1))
                    n_rows = WorksheetFunction.Max(n_rows_A, n_rows_B)
                    
                    ' Do the copy here
                    Sheets("Sheet1").Range("A1").Resize(n_rows, 12).Value = _
                        myrange.Resize(n_rows, 12).Value
                    
                Else
                    
                    n_rows_A = CountRows(myrange)
                    n_rows_B = CountRows(myrange.Offset(0, 1))
                    n_rows = WorksheetFunction.Max(n_rows_A, n_rows_B)
                    
                    ' Do the copy here
                    Sheets("Sheet2").Range("A1").Resize(n_rows, 12).Value = _
                        myrange.Resize(n_rows, 12).Value
                    
                End If
            Next i
        End If
    End With
End Sub


Function CountRows(ByRef r As Range) As Long
    If IsEmpty(r) Then
        CountRows = 0
    ElseIf IsEmpty(r.Offset(1, 0)) Then
        CountRows = 1
    Else
        CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
    End If
End Function

我也想关闭新打开的工作簿。

标签： excelvba

解决方案

从另一个工作簿复制范围

  • 如果其他东西有效，你可以在For Next循环中使用类似下面的东西，包括它下面的函数。

片段

        Dim wb As Workbook
        Set wb = Workbooks.Open(.SelectedItems(i))
        myrange = getRange(wb.ActiveSheet, "A:B")
        
        If InStr(.SelectedItems(i), "-RESUME") Then
            ' Do the copy here
            ThisWorkbook("Sheet1").Range("A1") _
              .Resize(myrange.Rows.Count, 12).Value = _
              myrange.Resize(, 12).Value
        Else
            ' Do the copy here
            ThisWorkbook("Sheet2").Range("A1") _
              .Resize(myrange.Rows.Count, 12).Value = _
              myrange.Resize(, 12).Value
        End If
        wb.Close SaveChanges:=False

功能

Function getRange( _
    aWorksheet As Worksheet, _
    Optional ByVal ColumnAddress As String = "A", _
    Optional ByVal FirstRowNumber As Long = 1) _
As Range

    If Not aWorksheet Is Nothing Then
        With aWorksheet
            Dim rng As Range
            Set rng = .Columns(ColumnAddress) _
              .Resize(.Rows.Count - FirstRowNumber + 1) _
              .Offset(FirstRowNumber - 1)
            Dim cel As Range
            Set cel = rng.Find( _
              What:="*", _
              LookIn:=xlFormulas, _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious)
            If Not cel Is Nothing Then
                Set getRange = rng.Resize(cel.Row - FirstRowNumber + 1)
            Else
            ' All cells below first row are empty.
            End If
        End With
    Else
    ' Worksheet not defined.
    End If

End Function

推荐阅读