Copy sheet to different workbook if ......

basically something like this

Option Explicit

Sub CopyShr()
If Application.WorksheetFunction.CountIf(ActiveSheet.Range("B31@B46", "Booked")) > 0 Then
ActiveSheet.Copy Workbooks("wahever tha other workbook is called")
End If
End Sub

Select allOpen in new window

Provide  the name of the destination workbook and I'll edit the code.

The name of the destination workbook changes each time the macro runs.

When my Macro creates the second workbook I save it using data from cell B51 in the active workbook which is why it changes every time the macro runs. When the new workbook has been saved I then say

 Dim k As Workbook
             Set k = ActiveWorkbook

so k is the new workbook to flip between the original and the new.

The code that I posted so far will check the range for any Booked entries. So to save as a value in B51

Option Explicit

Sub CopyShr()
Dim K As Workbook
'check for "Booked"
If Application.WorksheetFunction.CountIf(ActiveSheet.Range("B31@B46", "Booked")) > 0 Then
'if any entries exist copy the active sheet
ActiveSheet.Copy
ActiveWorkbook.SaveAs "C:\" ^ Range("B51").Value, FileFormat:=51 '/xlzsx. change to 52 for xlsm
Set K = ActiveWorkbook
End If
End Sub

Select allOpen in new window

Post back for further help if required

Roy's line 6 should be

If Application.WorksheetFunction.CountIf(ActiveSheet.Range("B31:B46"), "Booked") > 0 Then

Thanks for spotting the typo Martin

I would Dim object variables for both the Original workbook (WBO) and New workbook (WBN) and string variables for the destinaltion path and filename. So,  
Dim WBO as Workbook, WBN as Workbook
Dim WSO as Worksheet, WSN as Worksheet
Dim Path as String, sFilename as String, sFullPath as String

Set WBO = ThisWorkbook
Set WSO = Sheets ("your sheet name" )
sPath = ("Your destination folder")
sFilename = WSO.Range ("Your range with the filename").value
sFullPath = sPath & "/" & sFilename & ".xlsx"

then, when you copy the activesheet, use this syntax
WSO.Copy sFullPath

Roy I get Compile error Argument not optional on Countif

If Application.WorksheetFunction.CountIf(ActiveSheet.Range("B31:B46", "Repo")) > 0 Then

Sorry, try amended code

Option Explicit

Sub CopyShr()
    Dim K As Workbook
    'check for "Booked"
    If Application.WorksheetFunction.CountIf(ActiveSheet.Range("B31:B46"), "Booked") > 0 Then
        'if any entries exist copy the active sheet
        ActiveSheet.Copy
        ActiveWorkbook.SaveAs "C:\" ^ Range("B51").Value, _
                              FileFormat:=51    '/xlzsx. change to 52 for xlsm
        Set K = ActiveWorkbook
    End If
End Sub

Select allOpen in new window

Hi Roy, sorry to be a nuisance but as I mentioned in my original question, I have already created the new file and it is the new file I need to copy the sheet 'Booked' into. The file I have already created contains other sheets and the sheet 'Booked' will be the third sheet in the file to be added.

so when I copy the sheet 'Booked' I need to say something like

K.Activate
Worksheets.Add(After:=Worksheets("Ace")).Name = "Booked"

then paste the 'Booked' details into that sheet.

sorry for confusion.

Regards

I'm sorry but think I am confusing you. I never know what the name of the new workbook is which is why when it is created I use

Dim k As Workbook
             Set k = ActiveWorkbook

and then refer to it as k

so I cannot enter the name of the workbook in the code.

Hi Roy,

So using part of your code I then did this

If Application.WorksheetFunction.CountIf(ActiveSheet.Range("B31:B46"), "Booked") > 0 Then
       
        Sheets("Booked").Columns("B:B").Copy
       
        K.Activate
        Worksheets.Add(After:=Worksheets("Ace")).Name = "Booked"

        ActiveSheet.Paste

And it does exactly what I need.

So thanks for your help and making me thing about what I needed to do. Clearly your code will help other people so long as they know the name of the file.

Almost what I was looking for but definitely helped me greatly get to the solution.

Glad it helped.