循环 Excel 另存为

Question

我很难尝试运行这段代码。我的 objective 是保存为主文件 ("data entry") 并且文件扩展名基于另一个 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 个数据副本 entry.xlsm 并根据单元格引用进行扩展。例如；

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

并且输出应该是 121 excel 个文件，文件扩展名为 "data entry - Afghanistan"、"data entry - Algeria"、...、"data entry - Serbia".

问题是，循环不工作，只工作一次，输出只有 1 个文件，文件名使用单元格 A1 ("data entry - Afghanistan")。

Answer 1

无需每次循环打开要复制的工作簿。打开一次并使用 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:A" & Sheet1.Range("A" & Rows.count).End(xlUp).Row)
 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

Answer 2

这有很多问题：

fp、en 和 cRng 都是 Variant 数据类型，因为您明确声明它们属于某种类型；
mfn实际上没有声明；
保存工作簿时，您将文件扩展名 "xlsm" 作为文件名的一部分，不需要 FileFormat:=52 处理此问题；
主要问题是您如何尝试找到要循环到的最后一个单元格。

当你打开 "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

我认为如果 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)

循环 Excel 另存为

Loop Excel Save As

excel

vba

loops

save-as