Condense this code ?

Code:

---

Sub CFD()
Range("A2").Select
If Range("A2") <> "" Then
    ActiveWorkbook.SaveAs Filename:= _
    "P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A2").Value
End If
Range("A3").Select
If Range("A3") <> "" Then
    ActiveWorkbook.SaveAs Filename:= _
    "P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A3").Value
End If
    Range("A4").Select
If Range("A4") <> "" Then
    ActiveWorkbook.SaveAs Filename:= _
    "P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A4").Value
End If
    Range("A5").Select
If Range("A5") <> "" Then
    ActiveWorkbook.SaveAs Filename:= _
    "P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A5").Value
End If
Range("A6").Select
If Range("A6") <> "" Then
    ActiveWorkbook.SaveAs Filename:= _
    "P:\CET - e\TL Monthly Reports\TL Reports\" & Range("A6").Value
End If
End Sub

---

I am continuing on from the guy who used to do this job before and this code above runs all the way to a1000 and it looks like the previous guys has just repeated the above again and again . is there anyway to just make this run until it hits a blank cell in coloum A.:devil2:

Hi Khalid
Welcome to VBAX
Try the following. The first will skip over blanks; the second will stop at the first blank.

Code:

---

Sub CFD()
Dim cel as Range
For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
    If cel <> "" Then
        ActiveWorkbook.SaveAs Filename:= _
        "P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value
    End If
    Next
End Sub

---

or

Code:

---

Sub CFD2()
Dim cel as Range
For Each cel In Range(Cells(2, 1), Cells(2, 1).End(xlDown))
    ActiveWorkbook.SaveAs Filename:= _
    "P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value
    Next
End Sub

---

Quote:

---

Originally Posted by khalid79m

I am continuing on from the guy who used to do this job before and this code above runs all the way to a1000 and it looks like the previous guys has just repeated the above again and again . is there anyway to just make this run until it hits a blank cell in coloum A.:devil2:

---

Oh my God, that poor guy made 1000 repeated blocks of code? Wow, I feel bad for him. Just a little more knowledge would have helped him 1000x.

Could you try this :

Code:

---

dim i as integer
dim str, path as string
i = 2
str "A2"
path =      "P:\CET - e\TL Monthly Reports\TL Reports\"
While Range(str) <> ""
    Range(str).select
    ActiveWorkbook.SaveAs Filename:= path & str
    ' next one
    i = i+1
    str = "A" & i
wend

---

Hi Ambassadeur
Try to avoid selecting. It slows down the code and is almost never necessary.
Also, use Long instead of Integer. It's more efficient and you could exceed the limits of Integer (32767) with spreadsheet rows.
Declare your variables separately, Dim str, path as String only dims path. str is dimmed as Variant.

Amending your method to avoid selection gives

Code:

---


Dim i As Integer
Dim str as String, path As String
i = 2
str = "A2"
path = "P:\CET - e\TL Monthly Reports\TL Reports\"
While Range(str) <> ""
    str = "A" & i
    ActiveWorkbook.SaveAs Filename:=path & Range(str)
    i = i + 1
Wend

---

How do I get it to only save if the file doesnt alreay exsist ?

Change the SaveAs line to

Code:

---


  If Dir(path & Range(str)) = "" Then ActiveWorkbook.SaveAs Filename:=path & Range(str)

---

Code:

---

Sub CFD()
    Dim cel As Range
    For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
        If cel <> "" Then
            ActiveWorkbook.SaveAs Filename:= _
            "P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value
        End If
    Next
End Sub

---

is the best script as the first response you did only worked the remaining after that didnt.

so i just change the line

Code:

---

ActiveWorkbook.SaveAs Filename:= _
            "P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value

---

?

:help I tried the code amendment with the last scirpt you sent and it doesnt work, it comes up the file already exisit would you like to replace it#?

Apologies. I confused my reply to you and my response to Ambassadeur.

Code:

---

Sub CFD()
    Dim cel As Range, FName As String
    For Each cel In Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
    If cel <> "" Then
        FName = "P:\CET - e\TL Monthly Reports\TL Reports\" & cel.Value
        If Dir(FName) = "" Then ActiveWorkbook.SaveAs Filename:=FName
    End If
    Next
End Sub

---