Excel-從其他工作簿導入工作表

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