How to create new files from range - vba

Question

I would like to create new files (in the same folder) from sheet "lista strategiczna".D2 only if doesn't exist. Next offset one position down, and create next files etc. What I doing wrong?
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

I would set your range at the start, use a For loop and do away with selecting things (rarely a good idea). Your current code doesn't change aktywnaKomorka(it remains D2), you just activate the next cell below but your loop does not reference the active cell.
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
If you wanted to persist with your Do loop rather than Select add this line
set aktywnaKomorka=aktywnaKomorka.Offset(1, 0)