Excel VBA-將所有工作表從特定工作簿復制到活動工作簿中

Question

我正在嘗試將所有工作表從網絡驅動器上保存的文件復制到我當前的活動工作簿中。 復制它們后，我想隱藏它們。

我還沒有找到的棘手的部分是，每次重新運行宏時，我都希望以前復制的那些工作表被覆蓋或刪除，並替換為我現有文件中的新工作表。復制。

目前，我已將代碼設置為僅根據超鏈接的字符串復制到特定的工作表上。 以下是我已經開始的內容，但並不是我想要的方向。

請注意，以下是已編輯的腳本：

子ImportWorksheets（）

Dim wb As Workbook, ws As Worksheet, wbTarget As Workbook, wsTarget As Worksheet

Application.ScreenUpdating = False

Dim pth As String
    pth = wb.Path

Dim titleDetailPth As String
    titleDetailPth = Left(pth, InStrRev(pth, "\") - 1)

Dim filePthName As String
    filePthName = titleDetailPth & "\New Release Templates\" & "Key New Release Accounts Details.xlsx"

Set wb = ActiveWorkbook 'Your workbook

Set wbTarget = Workbooks.Open(filePthName, UpdateLinks:=False, ReadOnly:=True) 'The drive workbook

For Each wsTarget In wbTarget.Worksheets 'a loop for each worksheet on the drive workbook
    For Each ws In wb.Worksheets ' a loop for each worksheet on your workbook
        If wsTarget.Name = ws.Name Then 'if the sheet you are trying to import exist, it will delete it
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next ws
    wsTarget.Copy After:=wb.Sheets(wb.Sheets.Count) 'this will copy it into the last sheet
    wb.Sheets(wb.Sheets.Count).Visible = 0 'this will hide it
Next wsTarget
wbTarget.Close SaveChanges:=False
Application.ScreenUpdating = True

結束子

Answer 1

然后，這應該為您完成工作：

Sub ImportWorksheets()

    Dim wb As Workbook, ws As Worksheet, wbTarget As Workbook, wsTarget As Worksheet

    Application.ScreenUpdating = False


    Set wb = ThisWorkbook 'Your workbook

    Set wbTarget = Workbooks.Open("wherever your drive file is", UpdateLinks:=False, ReadOnly:=True) 'The drive workbook

    For Each wsTarget In wbTarget.Worksheets 'a loop for each worksheet on the drive workbook
        For Each ws In wb.Worksheets ' a loop for each worksheet on your workbook
            If wsTarget.Name = ws.Name Then 'if the sheet you are trying to import exist, it will delete it
                Application.DisplayAlerts = False
                ws.Delete
                Application.DisplayAlerts = True
            End If
        Next ws
        wsTarget.Copy After:=wb.Sheets(wb.Sheets.Count) 'this will copy it into the last sheet
        wb.Sheets(wb.Sheets.Count).Visible = 0 'this will hide it
    Next wsTarget
    wbTarget.Close SaveChanges:=False
    Application.ScreenUpdating = True

End Sub