L oop Excel Сохранить как - PullRequest
Новая
       89

L oop Excel Сохранить как

0 голосов
/ 12 апреля 2020

Я с трудом пытаюсь запустить этот код. Моя цель - сохранить как основной файл («ввод данных») и иметь расширение имени файла на основе другого файла 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

Ячейка A1 для ячейки A121 Book1 содержит 121 страну, и я хочу создать 121 копию файла entry.xlsm и иметь расширение на основе ссылки на ячейку. Например, 

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

. Выходные данные должны быть 121 файлом Excel с расширением имени файла, таким как «ввод данных - Афганистан», «ввод данных - Алжир», ..., «ввод данных - Сербия».

Проблема в том, что l oop не работает и работает только один раз, выводится только 1 файл с именем файла, используя ячейку A1 («ввод данных - Афганистан»).

Ответы [ 3 ]

0 голосов
/ 12 апреля 2020

С этим довольно много проблем:

  1. fp, en и cRng - все это типы данных Variant, поскольку вы явно объявляете их определенного типа;
  2. mfn фактически не объявлено;
  3. Когда вы сохраняете рабочую книгу, вы включаете расширение файла "xlsm" как часть имени файла, которое не требуется как FileFormat:=52 заботится об этом;
  4. Основная проблема заключается в том, как вы пытаетесь найти последнюю ячейку для l oop to.

Поскольку вы на самом деле ничего не делаете с "данными 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

С уважением,

0 голосов
/ 12 апреля 2020

Я думаю, что если ячейка A1 в ячейку A121 в Book1 содержит 121 страну, тогда вывод этого кода: 

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

- это Range ("A1"), поэтому l oop делает это только один раз

Попробуйте 

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

Или 

Set cRng = Sheet1.Range("A1",Range("A1")).End(xldown)
0 голосов
/ 12 апреля 2020

Нет необходимости открывать рабочую книгу для копирования на каждом l oop. Откройте его один раз и используйте 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
...