Macro to save selection into an existing workbook but into a new sheet inside

[mgamal22]

Hi, im trying to use this .SaveAs Filename:=filePath & currentName & ".xlsx" to save copy in a specific folder using the current name but the problem is there are already existing files with this current name so it comes up asking to replace these files which i dont want , what i want is to go into this existing file and paste the selection into sheet2 , can anyone help me out , Thanks

 

[Yongle]

Does Sheet2 already exist or should it be created by VBA?
If Sheet2 already exists (ie macro already applied previously), should Sheet3 be created instead?

 

[mgamal22]

Dim newBook As Workbook
Set newBook = Workbooks.Add


With newBook


Dim currentName As String
currentName = pvtField.PivotItems(item).Name
.Worksheets(1).Name = currentName
ws.Range("B2:H200").Copy
Worksheets(currentName).Range("B1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ws.Range("B2:H11").Copy
Worksheets(currentName).Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ws.Range("B23:H300").Copy
Worksheets(currentName).Range("B22").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets(currentName).Range("B16:F16").Merge
Worksheets(currentName).Range("B18:F18").Merge
Worksheets(currentName).Range("B21:F21").Merge
Worksheets(currentName).Columns("B:F").AutoFit
Worksheets(currentName).Columns("B").ColumnWidth = 50
Worksheets(currentName).Range("A1").Select
.SaveAs Filename:=filePath & currentName & ".xlsx"
.Close
End With
Set newBook = Nothing
Next item
Application.ScreenUpdating = True
End Sub

 

[mgamal22]

so the code above is to create a new workbook with the name of the phone number in the pivot field , sheet2 doesnt exist, i need to go to the workbook that has the same CurrentName and add sheet2 then paste the data in there

 

[Yongle]

These are the lines that are required

Dim wb As Workbook, sh As Worksheet
Set sh = ActiveSheet
Set wb = Workbooks.Open(filePath & currentName & ".xlsx")
sh.Copy after:=wb.Sheets(1)
wb.Save
'and use this to close 
wb.Close False

I have not tested with your code, but this should be close
- I have replaced variable sh with Worksheets(currentName)

[COLOR=#ff0000]Dim wb As Workbook[/COLOR]
Dim newBook As Workbook
Set newBook = Workbooks.Add


With newBook


    Dim currentName As String
    currentName = pvtField.PivotItems(Item).Name
    .Worksheets(1).Name = currentName
    ws.Range("B2:H200").Copy
    Worksheets(currentName).Range("B1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    ws.Range("B2:H11").Copy
    Worksheets(currentName).Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ws.Range("B23:H300").Copy
    Worksheets(currentName).Range("B22").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Worksheets(currentName).Range("B16:F16").Merge
    Worksheets(currentName).Range("B18:F18").Merge
    Worksheets(currentName).Range("B21:F21").Merge
    Worksheets(currentName).Columns("B:F").AutoFit
    Worksheets(currentName).Columns("B").ColumnWidth = 50
    Worksheets(currentName).Range("A1").Select
[COLOR=#ff0000]
    Set wb = Workbooks.Open(filePath & currentName & ".xlsx")
    Worksheets(currentName).Copy after:=wb.Sheets(1)
    wb.Save
    wb.Close False[/COLOR]

End With
Set newBook = Nothing
Next Item
Application.ScreenUpdating = True

This leaves the original workbook open, but should save and close the workbook requiring sheet inserted

 

[mgamal22]

Thanks man , its working now - i am trying to add specific text to this name .Worksheets(1).Name = currentName
i want it to be CurrentName & specific word , can it be done ?

 

[Yongle]

Is this what you mean?

[I][COLOR=#ff0000]After this line[/COLOR][/I]
Worksheets(currentName).Copy after:=wb.Sheets(1)
[I][COLOR=#ff0000]Insert this line to rename the sheet[/COLOR][/I]
wb.Sheets(2).Name= wb.Sheets(2).Name & "SpecificWord"