Ok, fairly long-winded explanation ahead, so apologies in advance!...

I have an excel sheet with a variety of information, broken down into areas. What I need to do is pull the information from each area into it's own workbook. However, if there is no information for a certain area, then I don't want to create a workbook for it.

Currently, I'm using the following code, which a) doesn't work, and b) if it did work, would result in a sheet for every area, meaning I'd have to check them all manually.

Basically, the code creates a workbook, saves it so that I have a name for the new workbook, then checks to see if there's anything in the master sheet that needs to be transferred over (This is probably a back-to-front way of doing things, but I didn't know how to do it any other way).

It is then meant to check the new workbook, and if it's got no data in it, save it as 'blank #'

This way means I'm going to have to include the same chunk of code several times, as there's about 30 areas to check for.

Any suggestions on how to make this work?

'create workbook

Workbooks.Add
Application.WindowState = xlMinimized
ActiveWorkbook.SaveAs Filename:="\Area 1.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

'search for info to transfer
num = 1
For i = 1 To 200
savenumber = 1
If Workbooks("BS550DLM5").Worksheets("BS550DLM5").Cells(i, 6) = "1226" Then
Workbooks("BS550DLM5").Worksheets("BS550DLM5").Range("A" & _
i & ":F" & i).Copy Destination:= _
Workbooks("Area 1").Sheets("Sheet1").Range("A" & num)
num = num + 1

End If
Next i

If Workbooks("Area 1").Sheets("Sheet1").Cells("A1").Value = "" Then
ActiveWorkbook.SaveAs Filename:="\blank" & savenumber _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
savenumber = savenumber + 1
Else
ActiveWorkbook.Save
End If