需要将附件中《数据源》里面的数据从表三开始往后的子表，数量列非空白项复制到《复制模板》里面，最总形成《成果》样式的表格，每天都是重复粘贴复制，有没有快速解决的办法

自己录制一个宏 ,再对录制的宏进行适当的修改,应该可以满足需要.

算了,正好有点时间,给你写一个吧,其余的模块,你可以自己仿照示例来写.

Attribute VB_Name = "copySheet"
'运行前, 数据源  和 【复制模板】 必须同时打开 !!
Public Function cpSht2Sht(ByVal iColflag As Integer, _
    iStartRow As Integer, iStartRow2 As Integer, _
    cSurSht As String, cTarSht As String, _
    ByRef arrColist) As Boolean
' 共用模块,拷贝Sheet间数据
' 参数说明:非零标志位 ，起始行，源Sheet，目标Sheet ，列对应数组.
' 为了简捷,这里省略了Error 处理语句,用户可以自己添加上.
Dim sht0 As Worksheet, sht1 As Worksheet
Dim iArrRow As Integer, iLastCol As Integer, iLastRow As Integer
Dim irow As Integer, icol As Integer
Dim arrData()
iArrRow = UBound(arrColist, 1)
iLastCol = arrColist(iArrRow, 0)  '获取终止列,至于起始列,默认是 arrColist(0, 0)

Set sht0 = Workbooks("数据源.xls").Worksheets(cSurSht)
Set sht1 = Workbooks("【复制模板】.xlsx").Worksheets(cTarSht)
'获取终止行 ,起始行则由参数2获取.
sht0.Activate

 iLastRow = sht0.UsedRange.Rows.Count

 arrData = sht0.Range(Cells(iStartRow, arrColist(0, 0)), Cells(iLastRow, iLastCol)).Value
'开始输出数据
sht1.Activate

For irow = 1 To UBound(arrData, 1)
    If arrData(irow, iColflag) <> 0 And arrData(irow, iColflag) <> "." Then
        For icol = 0 To iArrRow
            sht1.Cells(iStartRow2, arrColist(icol, 1)).Value = arrData(irow, icol + 1)
        Next icol
        iStartRow2 = iStartRow2 + 1 ' 目标表的起始输入行.
    End If
Next irow
ReDim arrData(0, 0)
cpSht2Sht = True
End Function

Sub CopySht()
Dim rlt As Boolean
Dim 参数1 As Integer, 参数2 As Integer, 参数3 As Integer
Dim 参数4 As String, 参数5 As String
'调用cpSht2Sht示例
'比如要把数据源的[表三甲]复制到模块的的[表三甲]中去,那么:
'数据源的[表三甲]的第5列非零时,需要复制,所以参数1 = 5
参数1 = 5
'从数据源的[表三甲]的第8行开始复制,所以参数2=8
参数2 = 8
'从目标表的[表三甲]的第8行开始输出,所以参数3=8
参数3 = 8
'源表名称:"表三甲",所以参数4="表三甲"
参数4 = "表三甲"
'目标表名称:"表三甲",所以参数5="表三甲"
参数5 = "表三甲"
'接下来,需要定义源表与目标表之间的列对应关系（参数6，是一个数组）
'由于有7列数列需要复制,故定义数组为7行,2列:
Dim arr1(6, 1) As Integer
arr1(0, 0) = 1: arr1(0, 1) = 2  '源表第1列,复制到目标表第2列
arr1(1, 0) = 2: arr1(1, 1) = 3  '源表第2列,复制到目标表第3列
arr1(2, 0) = 3: arr1(2, 1) = 4  '......
arr1(3, 0) = 4: arr1(3, 1) = 5
arr1(4, 0) = 5: arr1(4, 1) = 6 '直到下一行,有变化:
arr1(5, 0) = 6: arr1(5, 1) = 8 '源表第6列,复制到目标表第8列
arr1(6, 0) = 7: arr1(6, 1) = 9
' 6个参数定义完毕,以下调用公共模块,开始复制/写数据:
rlt = cpSht2Sht(参数1, 参数2, 参数3, 参数4, 参数5, arr1)
Debug.Print (rlt)
' 参照以上示例,可以把其它几个表间复制的动作都写成类似CopySht()这样的子程序,
' 而公共模块cpSht2Sht,可反复调用.
End Sub

' 参照以上示例,假定需要复制 [表四甲甲供材料表] -->[主材 (甲供)],可以这样做:
Sub CopySht2()
Dim rlt As Boolean
Dim 参数1 As Integer, 参数2 As Integer, 参数3 As Integer
Dim 参数4 As String, 参数5 As String
'调用cpSht2Sht示例
'数据源的[表四甲甲供材料表]的第9列非零时,需要复制,所以参数1 = 9
参数1 = 9
'从数据源的[表四甲甲供材料表]的第8行开始复制,所以参数2=8
参数2 = 8
'从目标表的[主材 (甲供)]的第7行开始输出,所以参数3=8
参数3 = 7
'源表名称:"表四甲甲供材料表",所以参数4="表四甲甲供材料表"
参数4 = "表四甲甲供材料表"
'目标表名称:"主材 (甲供)",所以参数5="主材 (甲供)"
参数5 = "主材 (甲供)"
'接下来,需要定义源表与目标表之间的列对应关系（参数6，是一个数组）
'由于有6列数列需要复制,故定义数组为6行,2列:
Dim arr1(5, 1) As Integer
arr1(0, 0) = 1: arr1(0, 1) = 2  '源表第1列,复制到目标表第2列
arr1(1, 0) = 2: arr1(1, 1) = 3  '源表第2列,复制到目标表第3列
arr1(2, 0) = 3: arr1(2, 1) = 4  '......
arr1(3, 0) = 4: arr1(3, 1) = 5
arr1(4, 0) = 5: arr1(4, 1) = 6 '直到下一行,有变化:
arr1(5, 0) = 6: arr1(5, 1) = 8 '源表第6列,复制到目标表第8列

' 6个参数定义完毕,以下调用公共模块,开始复制/写数据:
rlt = cpSht2Sht(参数1, 参数2, 参数3, 参数4, 参数5, arr1)
Debug.Print (rlt)

End Sub