Excel 将多个工作簿中的单个工作表移动并保存为新文件

我有一个Excel工作簿，用作文档索引。A列包含1000个文件名，B列包含指向网络上这些Excel文件的相应超链接。所有文件名都是唯一的

我的任务是打开1000个Excel中的每一个，移出一个工作表，并将该工作表另存为网络上另一个位置的新工作簿。对于1000个Excel文档中的每一个，我需要“提取”的工作表都有相同的标题“详细信息”

---

是否有办法通过VBA循环浏览所有1000个单元格，并通过超链接打开工作簿，移出“详细信息”工作表，将该详细信息工作表保存为自己的Excel文件，并带有a列中相应的文件名？

此代码将打开“索引”工作表B列中的每个超链接，检查每个工作簿中是否有特定的工作表，如果找到，则会将工作表另存为工作簿，并使用a列中的相应文本命名新工作簿。打开1k工作簿，然后将工作表另存为新工作簿可能需要一段时间才能完成。我在代码中提供了注释，以帮助理解正在发生的事情

Sub OpenWorkbooksWithHyperlinks()
Dim wsNdx As Worksheet: Set wsNdx = ThisWorkbook.Sheets("Sheet1") 'change to your workbook and sheet
'Dim wsName As String: wsName = "Details" 'define the worksheet you want to open
Dim wbLink As Range, ws As Worksheet, wsExists As Boolean

    With Application 'turn off to speed up code
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

For Each wbLink In wsNdx.Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row) 'set range to loop through
    Dim fName As String: fName = wbLink.Offset(, -1).Value2 'assign file name from column A

    If wbLink.Hyperlinks.Count > 0 Then
        ThisWorkbook.FollowHyperlink wbLink.Hyperlinks(1).Address 'open each hyperlink
    End If

    Dim wbsrce As Workbook: Set wbsrce = ActiveWorkbook 'set each workbook opened as a variable

    wsExists = False 'Define the initial Boolean value for wsExists
        For Each ws In wbsrce.Sheets 'loop through each worksheet to find "Details"
            If ws.Name = "Details" Then
                'when "Details" is found change wsExists to true and exit the For loop
                wsExists = True

                Exit For
            End If
        Next ws

        If wsExists = True Then 'Test wsExists and if True then copy the worksheet and saveas.
        'You can change the path as needed,I used "_Details" because I was saving to the same path, to keep it simple.
            ws.Copy
            Application.ActiveWorkbook.SaveAs Filename:=(ThisWorkbook.Path) & "\" & fName & "_Details" & ".xlsx"
            ActiveWorkbook.Close 'close the new workbook
            wbsrce.Close 'close the current source workbook
        End If

        'If a workbook does not have a worksheet named "Details" then this line will close wbsrce, and start the next loop
        If wsExists = False Then wbsrce.Close

Next

    With Application 'turn things back on
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With

End Sub

---

这回答了你的问题吗？谢谢你，肯，但不是特别的。这项任务类似，但我更希望提取1000个工作表，并将每个工作表保存为具有原始文件名的不同工作簿。相反，如果有办法系统地进入每个工作簿，删除“详细信息”工作表以外的所有工作表，并使用现有文件名重新保存，我也可以。是否有标题行？是你的超链接；文本、超链接、使用公式导出的超链接？确定。在本网站上搜索

[excel]将每张表格保存到不同的文件中

，该文件将找到您的问题的其他副本，这些副本将帮助您开始。在发布新问题之前，请始终在此处深入搜索现有问题和答案。变化是相当好的，一些非常相似的东西（如果不是完全相同的话）已经在这里被问到和回答过。谢谢！我一定会把它放到一个模块中并运行它。作为VBA编码的完全新手，这肯定超出了我的范围。然而，我将回顾所有这些，看看我能从中获得多少，因为我一生中只做过非常简单的javascript和html编码！再次谢谢你。我在5个小Excel文件的测试样本上运行了它。Your welcome，SO提供了关于编码问题的帮助，我建议您尝试编写自己的代码，即使您在SO或google上搜索了您试图完成的内容，尝试让它为您的特定任务工作，并且遇到问题。这个论坛非常适合帮助个人，但我们喜欢帮助那些试图首先完成编码任务的人。他们会做GMalc。我的下一个任务是使用您的方法，并将其与我正在构建的宏相结合，以规范化这些1K左右Excel文件的格式。