Question

我要将工作表1复制到1个文件夹中的多个相同工作簿中。当我这样做时，工作表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

我用于复制/替换的代码

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

1 个答案: