Loop Excel另存为

Question

美好的一天！

我在尝试运行此代码时遇到了困难。我的目标是另存为主文件（“数据输入”），并具有基于另一个excel文件（“ Book1”）的文件扩展名。这是我的代码：

Sub SaveAsLoop()

Dim wkb As Workbook
Dim fp, en, strName As String
Dim cRng, c as Range


Set cRng = Sheet1.Range("A1",Range("A121").End(xlup))
For Each c In cRng
strName = c.Value 

Set wkb = Workbooks.Open("C:\Users\Desktop\WFH\data entry.xlsm")

fp = "C:\Users\Desktop\WFH\"
mfn = "data entry - "
en = "xlsm"

wkb.SaveAs Filename:=fp & mfn & strName & en, FileFormat:=52

ActiveWorkbook.Close

Next c

End Sub

Book1的单元格A1到单元格A121中包含121个国家/地区，我想创建121个data entry.xlsm副本，并具有基于单元格引用的扩展名。对于前；

Sheet1
A1   | Afghanistan
A2   | Algeria
...    ...
A121 | Serbia

并且输出应该是带有文件扩展名的121个excel文件，例如“数据输入-阿富汗”，“数据输入-阿尔及利亚”，...，“数据输入-塞尔维亚”。

问题是，循环不起作用，只能循环一次，输出的只有1个文件，其文件名使用单元格A1（“数据输入-阿富汗”）。

希望你们能帮助我。预先感谢，请注意安全！

Answer 1

我认为如果Book1的单元格A1到单元格A121中包含121个国家/地区，则此代码的输出：

Set cRng = Sheet1.Range("A1",Range("A121").End(xlup))

是Range（“ A1”），因此循环仅使它一次

尝试

Set cRng = Sheet1.Range("A1",Range("A" & Range("A:A").Count).End(xlup))

或

Set cRng = Sheet1.Range("A1",Range("A1")).End(xldown)

Answer 2

存在很多问题：

1. [fp，en和cRng都是变量数据类型，因为您明确声明它们是某种类型；
2. mfn并未实际声明；
3. 保存工作簿时，您将文件扩展名“ xlsm”作为文件名的一部分包括在内，因为FileFormat:=52会处理此扩展名，所以不需要此文件。
4. 主要问题是您如何尝试找到要循环到的最后一个单元格。

由于打开“ data entry.xlsm”时实际上并没有做任何事情，并且您已经知道要处理多少行，因此可以使用FileCopy命令来更快地进行处理：

Sub sSaveLoop()
    On Error GoTo E_Handle
    Dim lngLoop1 As Long
    Dim strFileStub As String
    Dim strFileSource As String
    strFileSource = "C:\Users\Desktop\WFH\data entry.xlsm"
    strFileStub = "C:\Users\Desktop\WFH\data entry - "
    For lngLoop1 = 1 To 121
        FileCopy strFileSource, strFileStub & ActiveSheet.Cells(lngLoop1, 1) & ".xlsm"
    Next lngLoop1
sExit:
    On Error Resume Next
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sSaveLoop", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

问候，

Answer 3

无需在每个循环中打开要复制的工作簿。一次打开并使用SaveCopyAs：

Sub SaveAsLoop()
 Dim wkb As Workbook
 Dim fp As String, mfn As String, en As String, strName As String
 Dim cRng As Range, c As Range

 Set cRng = Sheet1.Range("A1", Range("A121").End(xlUp))
 fp = "C:\Users\Desktop\WFH\"
 mfn = "data entry - "
 en = ".xlsm"
 Set wkb = Workbooks.Open(fp & "data entry.xlsm")


 For Each c In cRng
    strName = c.value
    wkb.SaveCopyAs (fp & mfn & strName & en)
 Next c
End Sub