[已解决]将复制的内容放到指定的文件夹

liumiaomiao

要求： 点击按钮后，生成以单元格（A3：A16）内容为名称的工作簿，        
并把它们放到“生成的新工作簿”，请问代码该怎么修改？谢谢        







求助.rar (451.26 KB, 下载次数: 17)

2013-8-29 10:35 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

ligh1298

2013-8-29 09:02

1. Sub 生成新工作薄()
   
2. For Each Rng In Range("a3:a" & [a65536].End(3).Row)
   
3. mp1 = ThisWorkbook.Path & "\模板"
   
4. mp2 = ThisWorkbook.Path & "\新簿"
   
5. FileCopy mp1 & "模板.xlsm", mp2 & Rng & ".xlsm"
   
6. Next
   
7. End Sub

复制代码

楼主：是不是想要这样的？见附件！只需要打开“批量复制并重命名.xls”文件，点击按钮生成。

跳转到最佳答案楼层

我心飞翔410

你看看 是不是这样
Sub abc() '这个程序没有把指定的文件复制到指定的文件夹中
    Dim s1$, s2$, i%, j%, fc$, sname$
Application.DisplayAlerts=False ’显示/关闭警告框提示框
Application.ScreenUpdating= False ’显示/关闭屏幕刷新
    Dim arr As Variant
     Dim wb As Workbook
    On Error Resume Next
    i = Range("a65536").End(xlUp).Row
    arr = Range("a3:b" & i)
    For j = 1 To UBound(arr)
     Set wb = Workbooks.Add
       wb.Sheets("sheet1").Range("a3").Resize(UBound(arr), 1) = arr
       wb.SaveAs ThisWorkbook.Path & "/生成的新工作簿/" & arr(j, 1) & ".xls"
           wb.SaveAs Filename:= _
        ThisWorkbook.Path & "/生成的新工作簿/" & arr(j, 1) & ".xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
      wb.Close True
    Next j
Application.DisplayAlerts=true ’显示/关闭警告框提示框
Application.ScreenUpdating= true ’显示/关闭屏幕刷新
End Sub
修改哈这个直接保存03格式打开有问题 你是03的附加的就可以了

ligh1298

1. Sub 生成新工作薄()
   
2. For Each Rng In Range("a3:a" & [a65536].End(3).Row)
   
3. mp1 = ThisWorkbook.Path & "\模板"
   
4. mp2 = ThisWorkbook.Path & "\新簿"
   
5. FileCopy mp1 & "模板.xlsm", mp2 & Rng & ".xlsm"
   
6. Next
   
7. End Sub

复制代码

楼主：是不是想要这样的？见附件！只需要打开“批量复制并重命名.xls”文件，点击按钮生成。

liumiaomiao

谢谢两位的帮助