CODEWITHSUNDEEP
excelvba
Eoin2211
Eoin2211

Reputation: 911

VBA Macro Not 'Saving As'

I have a macro which applies conditional formatting and filters. The macro should filter the file and save this out, it should then remove filters and filter again using different columns and save these results to another file. The macro is running but the files don't seem to be saving?

Code

Sub Customer_Connections()
'
' Macro1 Macro
'
Application.ScreenUpdating = False
' Email Must Be In Column F

'Duplicate Email
Columns("F:F").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
    .Color = -16383844
    .TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .Color = 13551615
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$Z$999999").AutoFilter Field:=6, Criteria1:=RGB(255, _
    199, 206), Operator:=xlFilterCellColor

   ActiveWorkbook.SaveCopyAs ("Duplicate_Emails-" & Format(Now(), "ddmmyyyy") & ".xlsm")

'More Than One @
With Sheets("Customer Connections")

.Columns("G:G").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Columns("G:G").NumberFormat = "General"

Cells.Select
Selection.AutoFilter
With .Range("G2:G" & .Range("A" & .Rows.Count).End(xlUp).Row)
    .Formula = "=LEN(RC[-1])-LEN(SUBSTITUTE(RC[-1],""@"",""""))"
    .Copy
    .PasteSpecial xlPasteValues
End With
Range("G1").Select
ActiveCell.FormulaR1C1 = "Count Of @"

Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$L$999999").AutoFilter Field:=7, Criteria1:="2"


End With

  ActiveWorkbook.SaveCopyAs ("Two_@_In_Emails-" & Format(Now(), "mmddyyyy") & ".xlsm")

End Sub

Upvotes: 0

Views: 85

Answers (1)

Tim Williams
Tim Williams

Reputation: 166126

Try this:

ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & _
                    "\Two_@_In_Emails-" & Format(Now(), "mmddyyyy") & ".xlsm"

Upvotes: 1

Related Questions