Sub 按模板修改Excel文件()
Dim MoBanWorkBook As Workbook
Set MoBanWorkBook = Application.ActiveWorkbook
Dim MoBanSheet As Worksheet
Set MoBanSheet = MoBanWorkBook.Worksheets(1)
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "DAT FILE", "*.xls"
.Show
For i = 1 To .SelectedItems.Count
Dim theFile As String
theFile = .SelectedItems(i)
If MoBanWorkBook.FullName <> theFile Then
Dim theFileWorkBook As Workbook
Set theFileWorkBook = Workbooks.Open(Filename:=theFile)
Dim TheSheet As Worksheet
Set TheSheet = theFileWorkBook.Worksheets(1)
For Each Item In MoBanWorkBook.Names
'模板中的命名区域,枚举后赋予其他文件同样的值
Dim theAddress As String
theAddress = MoBanSheet.Range(Item).Address
TheSheet.Range(theAddress).Value = MoBanSheet.Range(theAddress).Value
Next Item
theFileWorkBook.Save
theFileWorkBook.Close
End If
Next
End With
End Sub