如何更新工作簿模板的Sheet1 …？

我有这段代码将数据从一个工作簿中的范围复制到特定模板的Sheet1。 （Sheet1中的数据然后填充模板文件中的第二个工作表。）每个文件都是在“names1”范围内为名称创build和命名的。

这似乎是完美的，但我需要做另外两件事情：

• 首先，我需要它来检查一个文件是否已经创build了文件名，如果是的话，不要覆盖它，或提示保存。
• 其次，最重要的是，我需要find一种方法来检查现有的文件，然后只用上面的信息覆盖Sheet1，而不更改文件中其他任何表单上的任何内容，然后保存并closures文件。 然后继续检查文件中的所有其他名称，并从模板创build一个新文件（因为我的代码已经完成），或者只更新sheet1并保存/closures文件。

我已经在这方面寻求帮助，但是由于我有限的VBA知识，我不确定在哪里放置加载项以及使用什么语法。 任何帮助将不胜感激！！！

这是我的工作代码：

Sub Smart1() Dim src As Workbook Dim dst As Workbook SavePath = ActiveWorkbook.Path Set src = ActiveWorkbook For Each C In Range("Names1") i = C.Row Name = Cells(i, 44).Value PSFFAll = Cells(i, 45).Value CLSFall = Cells(i, 46).Value CLSWin = Cells(i, 47).Value CLSEnd = Cells(i, 48).Value WWRFall = Cells(i, 49).Value WWRWin = Cells(i, 50).Value WWREnd = Cells(i, 51).Value DORFWin = Cells(i, 52).Value DORFEnd = Cells(i, 53).Value AccWin = Cells(i, 54).Value AccEnd = Cells(i, 55).Value fname = Cells(i, 44).Value & ".xlsx" Workbooks.Open FileName:=ThisWorkbook.Path & "\Smart1.xlsx" With Workbooks("Smart1.xlsx").Worksheets("Sheet1") .Range("a2").Value = Name .Range("B2").Value = PSFFAll .Range("C2").Value = CLSFall .Range("D2").Value = CLSWin .Range("E2").Value = CLSEnd .Range("F2").Value = WWRFall .Range("G2").Value = WWRWin .Range("H2").Value = WWREnd .Range("I2").Value = DORFWin .Range("J2").Value = DORFEnd .Range("K2").Value = AccWin .Range("L2").Value = AccEnd End With ActiveWorkbook.saveas FileName:=SavePath & "\" & fname ActiveWorkbook.Close True On Error Resume Next Next C End Sub 

Answer 1

这只是你的第一个问题的答案。 用这个来检查文件是否存在。

 Sub saveme() SavePath = "D:\folder" fname = "test.xls" fullsavepath = SavePath & "\" & fname On Error Resume Next If Dir(fullsavepath) <> "" Then Open fullsavepath For Binary Access Read Lock Read As #1: Close #1 End If If Err.Number <> 0 Then If MsgBox("A file with the name '" & fname & "' is already open." & vbCrLf & _ "Do you want to replace it?", vbYesNo + vbQuestion + vbDefaultButton2, _ "Microsoft Excel") = vbYes Then Application.DisplayAlerts = False Workbooks(fname).Close savechanges:=False ActiveWorkbook.SaveAs Filename:=fullsavepath Application.DisplayAlerts = True End If Else ActiveWorkbook.SaveAs Filename:=fullsavepath End If Err.Clear End Sub 

重要的部分是：

 If Dir(fullsavepath) <> "" Then Open fullsavepath For Binary Access Read Lock Read As #1: Close #1 End If 

Answer 2

这是答案！ 感谢Tweedle！ Sub Smart1（）Dim src As Workbook Dim dst As Workbook SavePath = ActiveWorkbook.Path

 Set src = ActiveWorkbook For Each C In Range("Names1") i = C.Row Name = Cells(i, 44).Value PSFFAll = Cells(i, 45).Value CLSFall = Cells(i, 46).Value CLSWin = Cells(i, 47).Value CLSEnd = Cells(i, 48).Value WWRFall = Cells(i, 49).Value WWRWin = Cells(i, 50).Value WWREnd = Cells(i, 51).Value DORFWin = Cells(i, 52).Value DORFEnd = Cells(i, 53).Value AccWin = Cells(i, 54).Value AccEnd = Cells(i, 55).Value fname = Cells(i, 44).Value & ".xlsx" If Dir(SavePath & "\" & fname) = "" Then 'Filename does not exist, then use template Set dst = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Smart1.xlsx") Else 'File already exists, then use existing & update Set dst = Workbooks.Open(Filename:=SavePath & "\" & fname) End If With dst.Worksheets("Sheet1") .Range("a2").Value = Name .Range("B2").Value = PSFFAll .Range("C2").Value = CLSFall .Range("D2").Value = CLSWin .Range("E2").Value = CLSEnd .Range("F2").Value = WWRFall .Range("G2").Value = WWRWin .Range("H2").Value = WWREnd .Range("I2").Value = DORFWin .Range("J2").Value = DORFEnd .Range("K2").Value = AccWin .Range("L2").Value = AccEnd End With Application.DisplayAlerts = False dst.Close True, SavePath & "\" & fname Application.DisplayAlerts = True On Error Resume Next Next C 

结束小组