Question

我正在努力使用我的VBA代码。而不是表中的固定值，其中包含工作簿应如何保存的名称。我的范围需要变化（下面的例子是从范围＃34开始; A3和＃34;）。

Sheets("CC").Select  'sheet with the names
Range("A3").Select   ' starting from this range are the names in a column
Selection.Copy
Sheets("CZK").Select  'going to different sheet to paste some value
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False      'pasting values to different sheet 
Application.CutCopyMode = False
Sheets("CC").Select        'returning back to the sheet with names
Nazev = Range("A3")
ActiveWorkbook.SaveAs Filename:=cesta & Nazev    'saving it with predefined path and name

我必须这样开始：

Set MyRange = Sheets("CC").Range("A3")   ' predefining varible range
Set MyRange = Range(MyRange, MyRange.End(xlDown))

然后我被困住了。谢谢你的帮助！

大卫

Answer 1

这样的事情对你有用：

Sub tst()

    Dim wb As Workbook
    Dim wsNames As Worksheet
    Dim wsDest As Worksheet
    Dim NameCells As Range
    Dim NameCell As Range
    Dim cesta As String
    Dim Nazev As String

    cesta = "C:\Test\"
    Set wb = ActiveWorkbook
    Set wsNames = wb.Sheets("CC")
    Set wsDest = wb.Sheets("CZK")
    Set NameCells = wsNames.Range("A3", wsNames.Cells(wsNames.Rows.Count, "A").End(xlUp))

    Application.DisplayAlerts = False
    For Each NameCell In NameCells
        Nazev = NameCell.Value
        wsDest.Range("B2").Value = Nazev
        wb.SaveAs cesta & Nazev & ".xlsm", xlOpenXMLWorkbookMacroEnabled
    Next NameCell
    Application.DisplayAlerts = True

End Sub

VBA - 从列表中创建多个文件

1 个答案: