Menu
Ask a question Report

VBA Copy sheet to new Excel File + automated manual data entry [Solved/Closed]

- - Latest reply: MaxStart
Posts
346
Registration date
Tuesday March 3, 2015
Status
Contributor
Last seen
July 3, 2015
 - Mar 28, 2015 at 03:23 PM
Excel Ask a question Report


Dears,

I hope this is not a to extensive VBA script request and this is the place to ask.
I need to create a excel file in an automated way as following:
I have an excel file with around 25 sheets (can grow in the future).
Each sheet has a specific name to it, that will not change.
The number of columns on each sheet is the same (28), but the number of rows varies.
In short I need to create a new file with a perfect copy of one of the sheets of my choosing.
That's not all, data in column 2, 15 & 16 is unique but needs to be entered manually for each row, as from row 3, row 1 an 2 being headers/titles.
I wish also the naming of the file be customized as follow: "standardname_sheetname_variabledata_column2data_column15data.xls"
this file will have to be stored on a shared drive starting with http:// or // I'm not sure yet.
The source file is by the way also on a shared drive.

The way I see this happen:
In another excel file I have
- a column/cell with a drop down containing the list of my sheet names
- 3 columns with the data I need to enter manually for column 2,15 & 16
- the variable data for the file naming
- data for standard name for the file naming
I push the button and you VBA magic does the trick ;o).

I this request understandable? Am I asking to much?
I'm working with Office Professional Plus 2010.

Thx
br,
See more 

3 replies

Report Respond to MaxStart
Posts
346
Registration date
Tuesday March 3, 2015
Status
Contributor
Last seen
July 3, 2015
 50
0
Thank you
please check this example and study it before asking, I will give it a bit more time when I get free, in the mean time you might check it out and try to adapt it to your needs, basically here two sheets are named copy me and copy me 2

Option Explicit

Sub TwoSheetsAndYourOut()
    Dim NewName As String
    Dim nm As Name
    Dim ws As Worksheet
    
    If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
    "New sheets will be pasted as values, named ranges removed" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub

    With Application
        .ScreenUpdating = False
        
'       Copy specific sheets
'       *SET THE SHEET NAMES TO COPY BELOW*
'       Array("Sheet Name", "Another sheet name", "And Another"))
'       Sheet names go inside quotes, seperated by commas
        On Error GoTo ErrCatcher
        Sheets(Array("Copy Me", "Copy Me2")).Copy
        On Error GoTo 0
        
'       Paste sheets as values
'       Remove External Links, Hperlinks and hard-code formulas
'       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select
        
'       Remove named ranges
        For Each nm In ActiveWorkbook.Names
            nm.Delete
        Next nm
        
'       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
    
'       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
        ActiveWorkbook.Close SaveChanges:=False
      
        .ScreenUpdating = True
    End With
    Exit Sub
    
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub
  • Copy the above code.
  • Open any workbook.
  • Press Alt + F11 to open the Visual Basic Editor (VBE).
  • From the Menu, choose Insert-Module.
  • Paste the code into the right-hand code window.
  • Close the VBE (Alt + Q)


--
Damn it !!!, is it ever gonna be the way I want it to be?
Report Respond to Sib
0
Thank you
Thx Maxstart,

I tested it and it worked fine.
This copy's a sheet you specified in the code to a new Excel file.
I could make this work. What I would do is create a button per sheet I need to copy. (I only need one sheet at a time).

This fur-fills only part of me needs, but it's a good start.

Wondering what you will come up next

Thx again.
Report Respond to MaxStart
Posts
346
Registration date
Tuesday March 3, 2015
Status
Contributor
Last seen
July 3, 2015
 50
0
Thank you
Option Explicit

Sub go()
    Dim NewName As String
    
    With Application
        .ScreenUpdating = False
        
        On Error GoTo ErrCatcher
        On Error GoTo 0
        
'       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "New Copy")
    
        ActiveSheet.Copy
'       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
        ActiveWorkbook.Close SaveChanges:=False
      
        .ScreenUpdating = True
    End With
    Exit Sub
    
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub


in this case the code is much simpler and will save only the active sheet to a new file
download this example I made for you with the button to automate the process
don't forget to inform us if it works for you so we can mark the question as solved.
wish you good times in Kioskea

--
Damn it !!!, is it ever gonna be the way I want it to be?
Report
MaxStart
Posts
346
Registration date
Tuesday March 3, 2015
Status
Contributor
Last seen
July 3, 2015
 50 -
here's a modified link to the example
Ask a question