用一个工作簿的内容填写另外一个工作簿的内容

zzzxxxyyy00

前来求助，非常新手。

在命名为填的工作簿中每个表中的黄色区域需要填写，数据来源为名称为源的工作簿中的相同名称的工作表，且数值为原来的一半。 file.rar (20.3 KB, 下载次数: 7)

2022-7-6 11:53 上传

点击文件名下载附件

webber04

源里没有日期，那应该填在填的哪一个日期行里呢？

3190496160

就如2楼所说，源表没有日期，单是，目标表是有日期的，究竟要填到哪里？最好上传你真实的文件

zzzxxxyyy00

3190496160 发表于 2022-7-7 11:43
就如2楼所说，源表没有日期，单是，目标表是有日期的，究竟要填到哪里？最好上传你真实的文件

可能没说清楚  将源.xlsx 中每个表中的D2的值得一半，填写到填.xlsx中相同名称表的B2、B3、B4和B5中。B2、B3、B4和B5的值相同，都是源.xlsx 中对应表中的D2的一半。

zzzxxxyyy00

3190496160 发表于 2022-7-7 11:43
就如2楼所说，源表没有日期，单是，目标表是有日期的，究竟要填到哪里？最好上传你真实的文件

可能没说清楚  将源.xlsx 中每个表中的D2的值得一半，填写到填.xlsx中相同名称表的B2、B3、B4和B5中。B2、B3、B4和B5的值相同，都是源.xlsx 中对应表中的D2的一半。和日期那一列没有关系。

3190496160

Sub tianbiao()
Application.ScreenUpdating = False
Dim sh As Worksheet
Dim arr()
ReDim arr(1 To Sheets.Count, 1 To 2)
For Each sh In Sheets
    n = n + 1
    arr(n, 1) = sh.Name
    arr(n, 2) = sh.[d2] / 2
Next sh
f = Dir(ThisWorkbook.Path & "\填.xls*")
If f = "" Then MsgBox "找不到填文件！": End
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
For i = 1 To n
    mc = arr(i, 1)
    wb.Worksheets(mc).[b2].Resize(4, 1) = arr(i, 2)
Next i
wb.Close True
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

file.rar (33.52 KB, 下载次数: 3)

2022-7-7 16:46 上传

点击文件名下载附件

webber04

附件供楼主参考

zzzxxxyyy00

webber04 发表于 2022-7-7 17:22
附件供楼主参考

感谢  感谢！！！！太谢谢了。