Question

我陷入僵局，需要一些帮助。我需要的功能是通过对话框打开工作簿并将特定的工作表导入到活动工作簿中。如果只有一张纸，但有人想添加另一张纸，则下面的宏工作正常，然后失败...

如何更改代码，使其仅导入特定的命名表？

<pre>
<code>
Sub Files()
Dim openfiles
Dim wb As Workbook
Dim sourcewb As Workbook
Dim newName As String
Dim x As Integer

Set wb = Application.ActiveWorkbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

openfiles = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files 
(*.xls;*.xlsx),*.xls;*.xlsx", MultiSelect:=True, Title:="Select file(s) for 
import!")

If TypeName(openfiles) = "Boolean" Then
MsgBox "You have to choose a file"
GoTo ExitHandler
End If


With wb
x = 1
While x <= UBound(openfiles)
    Set sourcewb = Workbooks.Open(Filename:=openfiles(x))
    newName = sourcewb.Name

For i = 1 To sourcewb.Sheets.Count
    sourcewb.Worksheets(i).Copy After:=.Sheets(.Sheets.Count)
    .Worksheets(.Sheets.Count).Name = newName
    Next
    sourcewb.Close
    x = x + 1
Wend
End With

'There is a lot of other code below this

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

</code>
</pre>

Answer 1

如何更改代码，使其仅导入特定的命名表？

您的代码未测试工作表名称，它只是将所有工作表从sourcewb工作簿复制到目标工作表。如果只想复制具有指定名称的图纸，则必须检查它是否存在：

For i = 1 To sourcewb.Sheets.Count
    If sourcewb.Worksheets(i).Name = "This is it" Then
        sourcewb.Worksheets(i).Copy After:=.Sheets(.Sheets.Count)
        .Worksheets(.Sheets.Count).Name = newName
        sourcewb.Close
        Exit Sub
    End If
    x = x + 1
Next

Excel-从其他工作簿导入工作表

1 个答案: