VBA Code:
Code:
Code:
Dim r, k As Integer
Dim kdnr As String
Dim kdname As String
Dim Arr As Variant
Application.PrintCommunication = False
Application.EnableEvents = False
Application.ScreenUpdating = False
r = 3
Arr = Array(".", ",", ";", "\", "/", "?", "'", ":", "<", ">", "*", "%", "&", "@", "#", "$")
Do Until IsEmpty(Cells(r, 1))
Sheets(2).Select
If Cells(r, 11) < 1 Then
r = r + 1
Else
kdnr = Cells(r, 2)
kdname = Cells(r, 3)
For i = LBound(Arr) To UBound(Arr)
kdname = Replace(kdname, Arr(i), "")
Next i
Sheets(1).Copy
ActiveWorkbook.SaveAs Filename:="H:\Branches\DACH330\Sales\POHLADAVKY\KlientiMakro\" & kdname & ".xlsx"
Dim s As Integer
Dim rng As Range
s = 2
Do Until IsEmpty(Cells(s, 1))
If Cells(s, 2) <> kdnr Then
Cells(s, 1).EntireRow.Delete
Else
s = s + 1
End If
Loop
ActiveWindow.Close savechanges:=True
Windows(wbName).Activate
Sheets(2).Select
r = r + 1
End If
Loop
Application.PrintCommunication = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Code: