在多个工作簿中查找和替换 vba

Question

我正在将 Sheet 1 复制到 1 个文件夹中的多个相同工作簿。当我这样做时，Sheet 1 中的公式仍然依赖于源工作簿。我想删除该依赖项，因此我试图查找连接字符串并将其替换为“”。由于文件的数量，1x1 这样做是不可行的 - 这就是为什么我正在寻找一些 VBA 帮助。

我有将 Sheet1 复制到文件夹中所有工作簿的代码。我找到了一段代码 RE：查找和替换。但是我不知道怎么拼凑起来。

如有任何帮助，我们将不胜感激。

Option Explicit
Public Sub CopySheetToAllWorkbooksInFolder()

    Dim sourceSheet As Worksheet
    Dim folder As String, filename As String
    Dim destinationWorkbook As Workbook

    'Worksheet in active workbook to be copied as a new sheet to the destination woorkbook

    Set sourceSheet = ActiveWorkbook.Worksheets("Sheet1")

    'Folder containing the destination workbooks

    folder = "'C:\Users\FOLDERLOCATION\[FILENAME.xlsm]"

    filename = Dir(folder & "*.xls", vbNormal)
    While Len(filename) <> 0
        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
        destinationWorkbook.Close True
        filename = Dir()  ' Get next matching file

 Wend
 End Sub

我有 copy/replace

的代码

fnd = "'C:\Users\FOLDERLOCATION\[FILENAME.xlsm]"
rplc = ""

Answer 1

我认为在 Sheet1 中的源工作簿中有引用源工作簿中其他工作表上的单元格的公式。让我们说 =Sheet2!A1 或类似的。假设目标工作簿包含与源工作簿中引用的同名的工作表，您可以使用Workbook.ChangeLink方法更新复制的工作表。

注：
1. 您的 folder 值看起来很可疑。我已经在我的系统上替换了一个有效路径来演示正确的格式。
2. 我在 Dir 函数中使用了 *.xls*。如果需要，恢复为 *.xls。

Public Sub CopySheetToAllWorkbooksInFolder()
    Dim sourceWB As Workbook, sourceSheet As Worksheet
    Dim folder As String, filename As String
    Dim destinationWorkbook As Workbook

    'Worksheet in active workbook to be copied as a new sheet to the destination woorkbook
    Set sourceSheet = ActiveWorkbook.Worksheets("Sheet1")
    Set sourceWB = sourceSheet.Parent

    'Folder containing the destination workbooks
    folder = "C:\Data\Temp\SO\Test\" ' "'C:\Users\FOLDERLOCATION\[FILENAME.xlsm]"

    filename = Dir(folder & "*.xls*", vbNormal)
    Do While Len(filename) <> 0
        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy Before:=destinationWorkbook.Sheets(1)
        destinationWorkbook.ChangeLink _
          Name:=sourceWB.Name, _
          NewName:=destinationWorkbook.Name, _
          Type:=xlExcelLinks
        destinationWorkbook.Close True
        filename = Dir()  ' Get next matching file
    Loop
 End Sub

在多个工作簿中查找和替换 vba

find and replace in multiple workbooks vba

vba

excel

excel-2016