如何从范围创建新文件

Question

我想从工作表“ listastrategyzna” .D2创建新文件（在同一文件夹中）（仅当不存在时）。 下一个偏移一个位置，并创建下一个文件等。我在做什么错？

Sub TworzenieZamowien()
    Dim thisWb As Workbook
    Dim nazwaPliku As String
    Set thisWb = ActiveWorkbook
    Dim aktywnaKomorka As Range
    Set aktywnaKomorka = Sheets("lista strategiczna").Range("D2")
    Dim FilePath As String
    FilePath = Dir(ActiveWorkbook.Path, vbDirectory)
      Do Until aktywnaKomorka = ""
      nazwaPliku = thisWb.Path & "\Zamówienie " & aktywnaKomorka & ".xls"
        If FilePath <> nazwaPliku Then
        Workbooks.Add
        ActiveWorkbook.SaveAs Filename:=nazwaPliku
        ActiveWorkbook.Close savechanges:=False
        aktywnaKomorka.Offset(1, 0).Select
        Else
        aktywnaKomorka.Offset(1, 0).Select
        End If
      Loop  
End Sub

Answer 1

我会在一开始就设置您的范围，使用For循环并取消选择内容（这是个好主意）。 您当前的代码不会更改aktywnaKomorka （仍为D2），您只需激活下面的下一个单元格，但是循环不会引用活动的单元格。

Sub TworzenieZamowien()

Dim thisWb As Workbook
Dim nazwaPliku As String
Set thisWb = ActiveWorkbook
Dim aktywnaKomorka As Range

With Sheets("lista strategiczna")
    Set aktywnaKomorka = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
End With

Dim FilePath As String, r As Range

FilePath = Dir(ActiveWorkbook.Path, vbDirectory)

For Each r In aktywnaKomorka
    If r <> vbNullString Then
        nazwaPliku = thisWb.Path & "\Zamówienie " & r & ".xls"
        If FilePath <> nazwaPliku Then
            Workbooks.Add
            ActiveWorkbook.SaveAs Filename:=nazwaPliku
            ActiveWorkbook.Close savechanges:=False
        End If
    End If
Loop

End Sub

如果您想继续执行Do循环而不是选择，请添加此行

set aktywnaKomorka=aktywnaKomorka.Offset(1, 0)