So I have a worksheet that generates a chart type of thing using information on 2 other worksheets. On It I have an extract button which should copy the entire workbook into a new workbook whilst making the sheets where the data is pulled from invisible to the user. My issue is, the chart worksheet has other features which require macros to be run, for example buttons that hide some of it etc. The issue is I cannot find whether its actually possible to copy through macros from a workbook into the new copied workbook? Anyone have an answer to this and if so, how would you do this? Here is the code I currently have which copies the workbook into a new workbook:
Sub EWbtn()
Dim OriginalWB As Workbook, NewCRCWB As Workbook
Set OriginalWB = ThisWorkbook
Set NewCRCWB = Workbooks.Add
OriginalWB.Sheets("Generator").Copy Before:=NewCRCWB.Sheets("Sheet1")
OriginalWB.Sheets("Module Part Number Tracker").Copy Before:=NewCRCWB.Sheets("Generator")
OriginalWB.Sheets("CRC").Copy Before:=NewCRCWB.Sheets("Module Part Number Tracker")
Application.DisplayAlerts = False
NewCRCWB.Worksheets("Generator").Visible = False
NewCRCWB.Worksheets("Module Part Number Tracker").Visible = False
NewCRCWB.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
End Sub
I'd take a copy of the original file and delete/hide sheets from that.
All code is copied over as part of the save.
Sub Test()
Dim wrkBk As Workbook
Dim sCopyFileName As String
Dim wrkSht As Worksheet
sCopyFileName = "C:\MyFolderPaths\Book2.xlsm"
'Create copy of original file and open it.
ThisWorkbook.SaveCopyAs (sCopyFileName)
Set wrkBk = Workbooks.Open(sCopyFileName)
'wrkbk.Worksheets does not include Chart sheets.
'wrkbk.Sheets would take into account all the types of sheet available.
For Each wrkSht In wrkBk.Worksheets
Select Case wrkSht.Name
Case "Generator", "Module Part Number Tracker"
wrkSht.Visible = xlSheetVeryHidden
Case "CRC"
'Do nothing, this sheet is left visible.
Case Else
Application.DisplayAlerts = False
wrkSht.Delete
Application.DisplayAlerts = True
End Select
Next wrkSht
wrkBk.Close SaveChanges:=True
End Sub
I managed to find an answer to my question.. This code works fine however you need to add "Microsoft Visual Basic for Applications Extensibility 5.x" as a reference via Tools -> References. Here is the code:
Dim src As CodeModule, dest As CodeModule
Set src = ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
Set dest = Workbooks("Book3").VBProject.VBComponents("ThisWorkbook") _
.CodeModule
dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)
Credit: Copy VBA code from a Sheet in one workbook to another?
Related
I'm new here, I've read the rules, but please inform/forgive me if I have missed anything or posted incorrectly.
Now, to my problem:
I have created my first form in Visual Basic that has allowed me to create a searchable and editable database.
Upon allowing colleagues to test the form, I quickly released that they cannot use any of their other Excel workbooks that they have open (The other workbooks are not related in any way to my workbook/form).
After some researching, I found that I can add (vbmodeless) to the button that opens the form. This then allows the team to flick between the form and use other workbooks to look at other information and then go back onto the form.
The only problem I have now, is that when they go back to the form, it reads an error in the macros, because its trying to use the macros on another workbook and not my workbook.
In short, is there any way you can use (vbmodeless), but lock the forms Macros to my specific workbook?
If anyone can solve this riddle, they will be my best friend. I'm aiming to have this ready for its presentation next week on the 6th of March.
Thank you.
Well, let's say like tigeravatar, you haven't declared a workbook :
Dim ws As Workbook
ws = ActiveWorkbook
'instead of
Sheets("Sheet1").Range("A3") = 5 'for example
'you would have
ws.Sheets("Sheet1").Range("A3") = 5
You can also work with the sheets itself, but you'll have to use parameters and search each :
Dim ws As Workbook
Dim sh, SpecificSheet1, SpecificSheet2 as Object 'To manipulate sheets
Dim Name_Sheet1, Name_Sheet2 As String
Set ws = ActiveWorkbook
Name_Sheet1= "Sheet1"
Name_Sheet2= "Sheet2"
For Each sh In Sheets
If InStr(sh.Name, Name_Sheet1) = 1 Then
Set SpecificSheet1 = sh
ElseIf InStr(sh.Name, Nom_Ref_Donnees) = 1 Then
Set SpecificSheet2 = sh
End If
Next
'Instead of :
Sheets("Sheet1").Range("A3") = 5 'for example
'You would use :
SpecificSheet1.Range("A3") = 5
According to your way of using subs, theses both solutions may need to use Public declaration of theses objects :
Option Explicit
Public ws As Workbook
Public SpecificSheet1, SpecificSheet2 as Object 'To manipulate sheets
Sub yoursub()
Dim sh, SpecificSheet1, SpecificSheet2 as Object 'To manipulate sheets
Dim Name_Sheet1, Name_Sheet2 As String
If (IsEmpty(ws)) Then
Set ws = ActiveWorkbook
Else
ws.activate
End If
Name_Sheet1= "Sheet1"
Name_Sheet2= "Sheet2"
For Each sh In Sheets
If InStr(sh.Name, Name_Sheet1) = 1 Then
Set SpecificSheet1 = sh
ElseIf InStr(sh.Name, Nom_Ref_Donnees) = 1 Then
Set SpecificSheet2 = sh
End If
Next
End Sub
I'd like to ask if you could help me with copying some worksheet data from workbook A into my active workbook (workbook B)
I have the following code in the main workbook to copy the data from workbook A
Public Sub Worksheet_Activate()
test
End Sub
Sub test()
Dim Wb1 As Workbook
Dim MainBook As Workbook
'Open All workbooks first:
Set Wb1 = Workbooks.Open("Z:\Folder\WorkbookA.xlsm")
'Set MainBook = Workbooks.Open(Application.ActiveWorkbook.FullName)
Set MainBook = Application.ActiveWorkbook
'Now, copy what you want from wb1:
Wb1.Sheets("Projekte").Cells.Copy
'Now, paste to Main worksheet:
MainBook.Worksheets("Projekte").Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
'Close Wb's:
Wb1.Close SaveChanges:=False
End Sub
I know, that it opens worksheet A and that it highlights and copys the data.
The script wont paste it into worksheet B (where the script is executed from)
Anybody know what i did wrong?
Kindest regards, and thanks for any help !
You should set the Mainbook (destination) first before the origin (if you're going to use ActiveWorkbook).
'Set MainBook First
Set MainBook = ThisWorkbook
'Open All workbook:
Set Wb1 = Workbooks.Open("Z:\Folder\WorkbookA.xlsm")
Just for clarity, it's just me being OC on this one.
you have to properly reference your workbook and worksheet objects
if you have to paste the whole content of range (including formatting, comments, ...), then you want to code like follows (explanations in comments):
Option Explicit
Sub test()
Dim targetSheet As Worksheet
Set targetSheet = ActiveSheet 'store currently active sheet
Workbooks.Open("Z:\Folder\WorkbookA.xlsm").Sheets("Projekte").UsedRange.Copy Destination:=targetSheet.Range("A1") ' open the wanted workbook and copy its "Projekte" sheet used range to 'targetSheet (i.e.: the sheet in the workbook where it all started) from its cell A1
ActiveWorkbook.Close SaveChanges:=False ' close the currently active workbook (i.e. the just opened one)
End Sub
if you only need to paste values, then this is the way to go (much faster!):
Option Explicit
Sub test()
Dim targetSheet As Worksheet
Set targetSheet = ActiveSheet 'store currently active sheet
With Workbooks.Open("Z:\Folder\WorkbookA.xlsm").Sheets("Projekte").UsedRange ' open the wanted workbook and reference its sheet "Projekte" used range
targetSheet.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
.Parent.Parent.Close SaveChanges:=False 'close the parent workbook of referenced range (i.e., the newly opened workbook)
End With
End Sub
My recommendation is never to use ActiveWorkbook.
In most cases when people use ActiveWorkbook they actually meant to use ThisWorkbook. The difference is:
ActiveWorkbook is the currently selected one which is "on top of the screen" in exact that moment when your code runs. That can be any workbook the user just clicked on while your code runs. So you never can be 100% sure to get the right workbook.
ThisWorkbook is the actual workbook your code runs at the moment. And this doesn't change ever. So this is a well defined reference and no gamble about which workbook is on top at the moment.
About why your approach did not work
Set Wb1 = Workbooks.Open("Z:\Folder\WorkbookA.xlsm") 'this line makes WorkbookA the active one
Set MainBook = Application.ActiveWorkbook 'this makes MainBook = WorkbookA
Therefore a simple Set MainBook = Application.ThisWorkbook should work here.
Another recommendation
Sheets and Worksheets is not the same. Make sure you never use Sheets when you can use Worksheets.
Sheets contains worksheets and charts
Worksheets contain only worksheets
An example Sheets(1).Range("A1") fails if it is a chart.
I need to take a spreadsheet and compare it with a spreadsheet from another workbook. I know that I can do this using VBA, but I will need to copy a spreadsheet from another workbook so that both spreadsheets will reside within the same workbook and be accessible for comparison. How do I copy a spreadsheet from one workbook into another using VBA?
You don't need to copy the worksheets over to compare them. Simply open both WorkBooks and and set reference to there WorkSheets.
Sub CompareWorkBooks()
Dim wbPending As Workbook
Dim wsPending As Worksheet
Set wbPending = Workbooks("Items Pending")
Set wsPending = wsPending.Worksheet("Items")
Dim wbRecieved As Workbook
Dim wsRecieved As Worksheet
Set wbRecieved = Workbooks("Items Recieved")
Set wsRecieved = Worksheet("Items")
End Sub
If you provide names for Workbooks & WorkSheets and provide column information, we can give you better answers in a shorter period of time. Don't be afraid to post your code either.
If you want a user to select the target workbook and worksheet:
Create a userform
Declare targetWorkbook and tartgetWorksheet at the top of the code module
Add a command button and a combo box
When the button is clicked a file dialog is opened
A reference is now set to the open file
The names of all the worksheets are added to the combo
Changing the combo box value will set the refernce to tartgetWorksheet
Option Explicit
Public targetWorkbook As Workbook
Public tartgetWorksheet As Worksheet
Private Sub CommandButton1_Click()
Dim targetWorkbook As Workbook
Dim ws As Worksheet
Set targetWorkbook = getTargetWorkbook
If targetWorkbook = Nothing Then
MsgBox "Sowmthing went wrong", vbCritical, "Try Again"
Else
For Each ws In targetWorkbook.Worksheets
ComboBox1.AddItem ws.Name
Next
End If
End Function
Function getTargetWorkbook() As Workbook
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
On Error Resume Next
Set getTargetWorkbook = Application.Workbooks.Open(.SelectedItems(1))
On Error GoTo 0
End With
End Function
Private Sub ComboBox1_Change()
Set tartgetWorksheet = targetWorkbook.Worksheets(ComboBox1.Value)
End Sub
I have an existing workbook that will be used by multiple users (who will name the workbook uniquely - I can set one Workbook Codename if needed though, though don't know how to do this?).
I need to create a macro that opens a new workbook (which presumably I won't know the name of? as it could be 'Book1', 'Book2', 'Book3' etc?), then returns to the original workbook where the macro is stored, and copies several (can do one at a time if needed) sheets (that I DO know the names of these sheets) and pastes them as new sheets into the new workbook that I created at the start. The macro does not need to Save the file (in fact it's preferable that it doesn't as I want the user to save the new workbook wherever is most convenient for the user).
I have attempted to show what the macro would do, showing the obvious problem that I do not know the names of the workbooks I am creating/copying from/pasting into.
Any help, much appreciated!
Sub CopySheetintoNewWorkbook()
'Macro opens new / blank workbook (name unknown?)'
Workbooks.Add
'Macro goes back to original workbook where macro is saved (of which the name is unknown to the macro - i.e., users can and will change it)'
Windows("UnknownWorkbookName-1").Activate
'Macro goes to a sheet which can be named and will be known, so this is no problem'
Sheets("KnownSheet").Select
'Macro creates a copy of the sheet and pastes it as a new sheet within the new, unknown named workbook'
Application.CutCopyMode = False
Sheets("KnownSheet").Copy Before:=Workbooks("UnknownWorkbookName-2").Sheets(1)
End Sub
We want to copy Sheet1 and Sheet2.
This relies on a tiny trick:
Sub qwerty()
Dim wb1 As Workbook, wbNEW As Workbook
Set wb1 = ActiveWorkbook
Sheets("Sheet1").Copy
Set wbNEW = ActiveWorkbook
wb1.Sheets("Sheet2").Copy after:=wbNEW.Sheets(1)
End Sub
When the first .Copy is performed, a new workbook is created and it becomes the ActiveWorkbook ........the rest is easy.
EDIT#1:
If we have a group of sheets to be copied, then we can create an array of sheet names and loop through the array, copying one sheet at a time:
Sub qwerty()
Dim wb1 As Workbook, wbNEW As Workbook
Dim ary() As String, s As String, i As Long
s = "Larry,Moe,Curly"
ary = Split(s, ",")
Set wb1 = ActiveWorkbook
i = 1
For Each a In ary
If i = 1 Then
Sheets(a).Copy
Set wbNEW = ActiveWorkbook
Else
wb1.Sheets(a).Copy after:=wbNEW.Sheets(1)
End If
i = 2
Next a
wbNEW.Activate
End Sub
So prior to asking this I searched and found something that was similar to what I was looking to do here.
Basically I have workbook AlphaMaster. This workbook is a template that I want to use to create new workbooks from weekly.
In this workbook there are sheets named: Monday-Saturday and additional sheets with a corresponding date for Mon, Tues, ect.
I have created a Form that loads on open of the workbook. What I want is when I click form run it will:
Run Code saving template as new workbook
Rename workbook based of input from userform1
Rename the workbooks with proper weekday
Workbook is named for a week end date dates of 6 sheets would renamed after this(example week ending 5th of Jan.) is put into user form as:
WeekEnd: Jan-5-2014
Dates
Mon:Dec.30
Tues:Dec.31
Weds:Jan.1
Thurs:Jan.2
Fri:Jan.3
Sat:Jan.4
Than click command. so far this is what I have:
Private Sub CommandButton1_Click()
Dim thisWb As Workbook, wbTemp As Workbook
Dim ws As Worksheet
On Error GoTo dummkopf
Application.DisplayAlerts = False
Set thisWb = ThisWorkbook
Set wbTemp = Workbooks.Add
On Error Resume Next
For Each ws In wbTemp.Worksheets
ws.Delete
Next
On Error GoTo 0
For Each ws In thisWb.Sheets
ws.Copy After:=wbTemp.Sheets(1)
Next
wbTemp.Sheets(1).Delete
wbTemp.SaveAs "blahblahblah\New.xlsx"
new.xlsx i want to be filled in from form
Vorfahren:
Application.DisplayAlerts = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Vorfahren
End Sub
Complications:
Currently while this does work I cant change the name of the document its named what I name it in the .saveAs area. I'm thinking I need to create an alternate function to handle this. Second, when it finishes my sheets are displayed in the reverse order of the template.
Some guidance/suggestions on where to go from here would be greatly appreciated!
A few issues here:
You cannot delete all Worksheets in a Workbook.
You should copy the sheet to the end to retain order (if the worksheets in source workbook is sorted):
For Each ws In thisWb.Sheets
ws.Copy After:=wbTemp.Sheets(wbTemp.Sheets.Count)
wbTemp.Sheets(wbTemp.Sheets.Count).Name = "NewSheetName" ' <-- Rename the copied sheet here
Next
If your source Worksheets does not have names "Sheet#" then delete the default sheets afterwards.
Application.DisplayAlerts = False
For Each ws In wbTemp.Sheets
If Instr(1, ws.Name, "Sheet", vbTextCompare) > 0 Then ws.Delete
Next
Application.DisplayAlerts = True
For SaveAs, refer to Workbook.SaveAs Method (Excel).
I use this in my application and works good
Set bFso = CreateObject("Scripting.FileSystemObject")
bFso.CopyFile ThisWorkbook.FullName, destinationFile, True
Once it's copied you can then open it in new Excel Object and do what ever you want with it.