将一个工作表复制到多个工作簿并删除外部引用

时间:2017-02-15 00:09:53

标签: excel vba excel-vba

我正在尝试将一个工作表所有数据复制到大约140个其他工作簿中。其他工作簿都没有具有相同名称的工作表。

我正在使用的代码在

之下
Sub DataAllSheet()

Dim path As String
Dim file As String
Dim wkbk As Workbook
Dim rCell As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

path = "I:test\"
file = Dir(path)

Application.DisplayAlerts = False

Do While Not file = ""
    Workbooks.Open (path & file)
    Set wkbk = ActiveWorkbook
    Sheets.Add After:=Sheets(Sheets.Count)

    On Error GoTo Sheet_exists
    ActiveSheet.Name = "All Data"
    On Error GoTo 0
    ThisWorkbook.Sheets("All Data").Range("A2:DH2").Copy    Destination:=wkbk.Sheets("All Data").Range("A2")

    For Each rCell In wkbk.Sheet("All Data").UsedRange
        If InStr(rCell.Formula, ThisWorkbook.Name) > 0 Then
            rCell.Replace what:="[*]", replacement:=""
        End If        
    Next

    wkbk.Save
    wkbk.Close
    file = Dir        
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

Sheet_exists:
Sheets("All Data").Delete
Resume

End Sub

当我点击运行时,我得到一个运行时错误424对象必需。当我点击调试时,它突出显示 -

 For Each rCell In wkbk.Sheet("All Data").UsedRange

我不确定需要什么对象?

我刚刚意识到I:test \文件夹中的其他一些工作簿都保存为.xlsx会导致错误吗?

1 个答案:

答案 0 :(得分:0)

用以下代码替换整个for-next循环:

wkbk.Worksheets("All Data").UsedRange.Value = wkbk.Worksheets("All Data").UsedRange.Value