Add extracted Sheet by renaming to the existing file

sanjuss2

Board Regular
Joined
Nov 28, 2014
Messages
65
Hi,
Thanks in advance ...
Actually I preparing some data & I need vba code for adding a sheet into the previously created file with the prescribed name of referenced cell ...

Viz. I have created dropdown list of products in Column C i.e. computer, Electrical & Furniture_Fixtures of Sheet2 ... which I use to extract the data from datasheet i.e. sheet1

If I am creating list by selecting Computer It is extracting record from datasheet & place in extract sheet i.e. sheet2 ... Then I used following code to create file of extracted data

VBA Code:
 Sub CopyPasteValues()
 Dim w As Worksheet
  Dim DestinationPath As Variant
 Dim DirName, FileName As String
 DirName = ThisWorkbook.Sheets("Extract").Range("A1").Value
        On Error Resume Next
     MkDir ThisWorkbook.Path & "\" & DirName
     MsgBox ("Folder Created successfully")
    On Error GoTo 0
  DestinationPath = ThisWorkbook.Path & "\" & DirName
 FileName = ThisWorkbook.Sheets("Extract").Range("A2").Value
 ActiveWindow.SelectedSheets.Copy
For Each w In ActiveWorkbook.Sheets
  With w.UsedRange
 .Value = .Value
 End With
 Next w
 ActiveWorkbook.SaveAs FileName:=DestinationPath & "\" & DirName & " " & FileName & ".xls", FileFormat:=xlNormal
 MsgBox ("File created Successfully")
Call RenameSheet
End Sub

Next time if I select electrical it is extracting data then how i can add electrical sheet into the previously created file i.e. for computer....
If I use above code it is overwrite the same file
I am using following code to renaming the sheet but How I can add sheet into the previous created / closed file?
VBA Code:
Dim xWs, xSSh As Worksheet
Dim xRngAddress, xName  As String
Dim xInt As Integer
xRngAddress = Application.ActiveCell.Address
On Error Resume Next
Application.ScreenUpdating = False
For Each xWs In Application.ActiveWorkbook.Sheets
    xName = xWs.Range("C1").Value
    If xName <> "" Then
        xInt = 0
        Set xSSh = Nothing
        Set xSSh = Worksheets(xName)
        While Not (xSSh Is Nothing)
            Set xSSh = Nothing
            Set xSSh = Worksheets(xName & "(" & xInt & ")")
            xInt = xInt + 1
        Wend
        If xInt = 0 Then
            xWs.Name = xName
        Else
            If xWs.Name <> xName Then
                xWs.Name = xName & "(" & xInt & ")"
              End If
         End If
    End If
Next
 Application.ScreenUpdating = True
End Sub

Though I have already posted the post on excelForum with an attachment, I beg your patronage to resolve the issue...

Your response will help to kill the time.... thanks in advance again...
 

Attachments

  • Image for excel board.jpg
    Image for excel board.jpg
    102.3 KB · Views: 1

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
If anyone have different code to add extracted worksheet in closed workbook, let me know because I have stuck in work your assistance help a lot
 
Upvote 0

Forum statistics

Threads
1,213,558
Messages
6,114,296
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top