按模板批量修改Excel文件内容

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