格式模板大批量替换

xiao65403329

大批量的格式文件替换新模板，已上附件各位大神帮忙编写一个VB，自己试过就是不行了!

图片不用更换  图片以后要自己从新做过

蓝桥玄霜

数据位置都是一样的，只有一个个对应写上去，没有简便方法。

xiao65403329

蓝桥玄霜 发表于 2018-8-2 12:21
数据位置都是一样的，只有一个个对应写上去，没有简便方法。

一个简单复制粘贴   我做了一个但是行不通老师能帮我看看吗？
Sub 复制()
'
' 复制 宏
'
' 快捷键: Ctrl+g
'
    Windows("excel3").Activate
    Application.Run "仙女山公墓管理系统.xlsm!打开安葬信息模板"
    Windows("excel3").Activate
    Range("B2:B3").Select
    Selection.Copy
    Windows("安葬信息模版.xlsm").Activate
    Range("B2").Select
    ActiveSheet.Paste
    Windows("excel3").Activate
    Range("D2:D3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("安葬信息模版.xlsm").Activate
    Range("D2").Select
    ActiveSheet.Paste
    Windows("excel3").Activate
    Range("F2:G2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("安葬信息模版.xlsm").Activate
    Range("F2:G2").Select
    ActiveSheet.Paste
    Windows("excel3").Activate
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("安葬信息模版.xlsm").Activate
    Range("B5").Select
    ActiveSheet.Paste
    Windows("excel3").Activate
    Range("D5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("安葬信息模版.xlsm").Activate
    Range("D5").Select
    ActiveSheet.Paste
    Windows("excel3").Activate
    Range("B11:C11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("安葬信息模版.xlsm").Activate
    Range("F5:G5").Select
    ActiveSheet.Paste
    Windows("excel3").Activate
    Range("E11:F11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("安葬信息模版.xlsm").Activate
    Range("E11:F11").Select
    ActiveSheet.Paste
    Windows("excel3").Activate
    Range("F15:G16").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "2016.6.5"
    Windows("安葬信息模版.xlsm").Activate
    Range("F15:G15").Select
    ActiveCell.FormulaR1C1 = "2016.6.5"
    Range("G21").Select
End Sub