创建文件夹并复制到母表数据。

djyang

老师：帮忙看看把主表中的黄色数据复制到资产负债表及利润表（做为母表）绿色表格中，并创立以主表中的B1为文件夹，以f1为文件名存在该文件夹中。

老师那里出错.rar (52.66 KB, 下载次数: 1)

2019-11-9 16:42 上传

点击文件名下载附件

Sub fuzhi()

Path = ThisWorkbook.Path &"\" & [B1] & ""

IfDir(Path, vbDirectory) = "" Then

    MkDir Path

End If

Application.DisplayAlerts = False

Set template =Workbooks.Open(ThisWorkbook.Path & "\" & "资产负债表及利润表.xlsx")

For i = 3 ToThisWorkbook.Sheets(1).[a65536].End(xlUp).Row

With template.Sheets("主表")

Arr = sh.[A1].CurrentRegion

For h = 8 To 38

For x = 4 To 5

Cells(h, x) = Trim(Arr(h + 1, x))

Next

Next

For h = 8 To 38

For x = 8 To 9

Cells(h, x) = Trim(Arr(h + 1, x))

Next

Next

For h = 7 To 38

For x = 15 To 16

Cells(h, x) = Trim(Arr(h + 1, x))

Next

Next

End With

   Set sh = ActiveSheet

   pth = ThisWorkbook.Path & "\" & [A2] &".xlsx"

    x= ThisWorkbook.Path

   If Dir(pth) <> "" Then

      

     FileCopy ThisWorkbook.Path & "\" & [A2] &".xlsx", ThisWorkbook.Path & "\" & [B1] &"\" & [F1] & ".xlsx"

      

EndIf

Next

End Sub

Yalishanda30

附件供参考，不知道楼主为啥要一个个单元格填入？

djyang

Yalishanda30 发表于 2019-11-9 21:16
附件供参考，不知道楼主为啥要一个个单元格填入？

菜鸟一位，是网上查其他人的改的。