求修改代码，有部分问题

Comet_95

此代码是将透视表数据批量填到模板中，主要填到以下三个表

问题一
外承包面积复制到出租经营面积中，但是复制的列错误了
问题二
部分类型不复制，如公共管理与公共服务用地

望各位大侠指正
附代码

1. Sub 生成数据()
   
2.     Dim dicData As Object
   
3.     Dim vData As Variant, nRow As Integer, vFill As Variant
   
4.     Dim vVillage As Variant, vType As Variant, sData As String, sType As String
   
5.     Dim wSH As Worksheet, vSH As Variant
   
6.     Dim dicSH As Object, vCol As Variant, nCol As Integer
   
7.    
   
8.     Application.ScreenUpdating = False
   
9.     Application.DisplayAlerts = False
   
10.    
    
11.     vData = Sheet1.UsedRange.Value '已使用区域的范围
    
12.     Set dicData = CreateObject("Scripting.Dictionary")
    
13.     For nRow = 1 To UBound(vData) '行数
    
14.         sData = Trim(vData(nRow, 1)) '村名
    
15.         vType = Trim(vData(nRow, 2)) '资源类型
    
16.         If sData = "" Or sData Like "*村" Then
    
17.             If sData <> "" Then
    
18.                 vVillage = sData
    
19.                 Set dicData(vVillage) = CreateObject("Scripting.Dictionary")
    
20.             End If
    
21.             If vType <> "" Then dicData(vVillage)(vType) = Val(vData(nRow, 3))
    
22.         End If
    
23.     Next
    
24.     With Workbooks.Open(ThisWorkbook.Path & "\附件2农村集体资产清产核资汇总表（定稿）.xlsx")
    
25.         Set dicSH = CreateObject("Scripting.Dictionary")
    
26.         For Each wSH In .Sheets
    
27.             vSH = vSH + 1
    
28.             If wSH.Name Like "*农用地*" Or wSH.Name Like "*建设用地*" Or wSH.Name Like "*未利用地*" Then
    
29.                 Set dicSH(vSH) = CreateObject("Scripting.Dictionary")
    
30.                 vData = wSH.UsedRange.Value
    
31.                 For nRow = 9 To UBound(vData)
    
32.                     If vData(nRow, 1) Like "相关事项说明*" Then
    
33.                         nRow = nRow - 1
    
34.                         Exit For
    
35.                     Else
    
36.                         sType = Trim(Replace(vData(nRow, 2), " ", ""))
    
37.                         For Each vType In dicData(vVillage).Keys
    
38.                             If sType Like "*" & vType & "*" Then
    
39.                                 vData(nRow - 8, 1) = vType
    
40.                                 Exit For
    
41.                             End If
    
42.                         Next
    
43.                     End If
    
44.                 Next
    
45.                 If nRow > UBound(vData) Then nRow = nRow - 1
    
46.                 ReDim vFill(1 To nRow - 8, 1 To UBound(vData, 2) - 2)
    
47.                 dicSH(vSH)("填写数据") = vFill
    
48.                 ReDim Preserve vData(1 To UBound(vData), 1 To 1)
    
49.                 vData = Application.WorksheetFunction.Transpose(vData)
    
50.                 ReDim Preserve vData(1 To nRow - 8)
    
51.                 If wSH.Name Like "*农用地*" Then
    
52.                     dicSH(vSH)("填数据列") = Array(2, 9)
    
53.                 ElseIf wSH.Name Like "*建设用地*" Then
    
54.                     dicSH(vSH)("填数据列") = Array(2, 13)
    
55.                 Else
    
56.                     dicSH(vSH)("填数据列") = Array(1)
    
57.                 End If
    
58.                 dicSH(vSH)("数据") = vData
    
59.                 dicSH(vSH)("最后一行") = nRow
    
60.             End If
    
61.         Next
    
62.         For Each vVillage In dicData.Keys
    
63.             sData = "临邑  乡镇（街）" & vVillage & "（居）      组                          201  年   月  日                                         单位：亩、立方米、元"
    
64.             For Each vSH In dicSH.Keys
    
65.                 vCol = dicSH(vSH)("填数据列")
    
66.                 nRow = dicSH(vSH)("最后一行")
    
67.                 vData = dicSH(vSH)("数据")
    
68.                 vFill = dicSH(vSH)("填写数据")
    
69.                 For nRow = 1 To UBound(vFill)
    
70.                     vType = vData(nRow)
    
71.                     If dicData(vVillage).Exists(vType) Then
    
72.                         nCol = 0
    
73.                         Do While nCol <= UBound(vCol)
    
74.                             If nRow > 1 Then vFill(nRow, vCol(nCol)) = dicData(vVillage)(vType)
    
75.                             vFill(1, vCol(nCol)) = vFill(1, vCol(nCol)) + dicData(vVillage)(vType)
    
76.                             nCol = nCol + 1
    
77.                         Loop
    
78.                     End If
    
79.                 Next
    
80.                 With .Sheets(vSH)
    
81.                     .[A4] = sData
    
82.                     .[c9].Resize(UBound(vFill), UBound(vFill, 2)) = vFill
    
83.                 End With
    
84.                
    
85.             Next
    
86.             .Sheets("资源清查明细表（农用地）").[d10] = "=SUM(RC[3],RC[7])"
    
87.             .Sheets("资源清查明细表（农用地）").[d11] = "=SUM(RC[3],RC[7])"
    
88.             .Sheets("资源清查明细表（农用地）").[d12] = "=SUM(RC[3],RC[7])"
    
89.             .Sheets("资源清查明细表（农用地）").[d13] = "=SUM(RC[3],RC[7])"
    
90.             .Sheets("资源清查明细表（农用地）").[d14] = "=SUM(RC[3],RC[7])"
    
91.             .Sheets("资源清查明细表（农用地）").[d15] = "=SUM(RC[3],RC[7])"
    
92.             .Sheets("资源清查明细表（农用地）").[d9] = "=SUM(R[1]C:R[7]C)"
    
93.             .Sheets("资源清查明细表（农用地）").[g9] = "=SUM(R[1]C:R[7]C)"
    
94.             .Sheets("资源清查明细表（农用地）").[k9] = "=SUM(R[1]C:R[7]C)"
    
95.             .Sheets("资源清查明细表（农用地）").[m9] = "=SUM(R[1]C:R[7]C)"
    
96.             .Sheets("资源清查明细表（农用地）").[c9] = "=SUM(RC[1],RC[10])"
    
97.             .Sheets("资源清查明细表（农用地）").[c10] = "=SUM(RC[1],RC[10])"
    
98.             .Sheets("资源清查明细表（农用地）").[c11] = "=RC[1]"
    
99.             .Sheets("资源清查明细表（农用地）").[c12] = "=RC[1]"
    
100.             .Sheets("资源清查明细表（农用地）").[c13] = "=RC[1]"
     
101.             .Sheets("资源清查明细表（农用地）").[c14] = "=RC[1]"
     
102.             .Sheets("资源清查明细表（农用地）").[c15] = "=RC[1]"
     
103.             .Sheets("资源清查明细表（农用地）").[c16] = "=RC[1]"
     
104.             .Sheets("资源清查明细表（建设用地）").[d9] = "=SUM(R[1]C:R[6]C)"
     
105.             .Sheets("资源清查明细表（建设用地）").[o9] = "=SUM(R[1]C:R[6]C)"
     
106.             .Sheets("资源清查明细表（建设用地）").[c9] = "=RC[1]"
     
107.             .Sheets("资源清查明细表（建设用地）").[c10] = "=RC[1]"
     
108.             .Sheets("资源清查明细表（建设用地）").[c11] = "=RC[1]"
     
109.             .Sheets("资源清查明细表（建设用地）").[c12] = "=RC[1]"
     
110.             .Sheets("资源清查明细表（建设用地）").[c13] = "=RC[1]"
     
111.             .Sheets("资源清查明细表（建设用地）").[c14] = "=RC[1]"
     
112.             .Sheets("资源清查明细表（建设用地）").[c15] = "=RC[1]"
     
113.             .SaveAs ThisWorkbook.Path & "\结果" & vVillage & ".xlsx"
     
114.         Next
     
115.         .Close False
     
116.     End With
     
117.     MsgBox ("成功！")
     
118.     Application.DisplayAlerts = True
     
119.     Application.ScreenUpdating = True
     
120.    
     
121. End Sub
     

复制代码

Comet_95

二楼为文件及代码