I have a code written for one excel sheet in the form of Macro, In this macro, I am generating a copy of current workbook to a different location. Now, I need to access this copied excel workbook to delete some of its Worksheets from the macro.
can anyone tell me how to access the newly copied sheet from the current excel sheet macro?
The following code will allow you to edit a copy of your workbook:
Sub test()
Dim wb As Workbook
Dim strName as String
strName = "" & ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs Filename:=strName
Set wb = Workbooks.Open(strName)
Application.DisplayAlerts = False 'Prevents that user is asked when sheets are deleted
wb.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
wb.Close SaveChanges:=True
End Sub
Related
So I have two excel workbooks - Workbook A is used as a userform and Workbook B as a database with all the data entries (B is a merged file). Whenever I open Workbook A, I would like to pull all the data from Workbook B automatically and copy it into Workbook A in a separate Worksheet. In doing so, I can implement some other functionalities like retrieval of previous entries.
So I used the following cod embedded in Workbook:
Public Sub Workbook_open()
Call get_AllUpdateEntries
End Sub
Sub get_AllUpdateEntries()
Dim oriWorkbook As Workbook
Dim destWorkbook As Workbook
Set oriWorkbook = Workbooks.Open("FilePath")
Set destWorkbook = ThisWorkbook
oriWorkbook.Worksheets("Sheet Name").Copy
destWorkbook.Worksheets("Sheet Name").Paste
x.Close SaveChanges:=False
End Sub
However, I cannot get this macro running. It doesn't copy the Worksheet as I want, and additionally, another, unwanted Workbook is opened.
When you copy the worksheet to no location, it creates a new active workbook with a single worksheet (a copy of the original).
Provide an immediate destination for the copied worksheet.
Sub get_AllUpdateEntries()
Dim oriWorkbook As Workbook
Dim destWorkbook As Workbook
Set oriWorkbook = Workbooks.Open("FilePath")
Set destWorkbook = ThisWorkbook
'remove the destination worksheet if it already exists
on error resume next
application.displayalerts = false
destWorkbook.worksheets("All Update Entries").delete
application.displayalerts = true
on error goto 0
'copy worksheet to the end of the worksheet queue in ThisWorkbook
oriWorkbook.Worksheets("Sheet Name").Copy _
After:=destWorkbook.Sheets(destWorkbook.Sheets.count)
oriWorkbook.Close SaveChanges:=False
'rename the transferred worksheet
destWorkbook.Sheets(destWorkbook.Sheets.count).name = "All Update Entries"
End Sub
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?
Currently trying to figure out how to have my code that auto saves and closes open workbooks to avoid vba project workbooks without naming the vba project workbooks. Is there a way to get your code to recognize vba workbooks vs the other open workbooks I'm trying to save and close?
Option Explicit
Public ThisFile As String
Public Path As String
Sub CloseAndSaveOpenWorkbooks()
Dim Wkb As Workbook
Path = [D1]
With Application
.ScreenUpdating = False
'Loop through the workbooks collection
For Each Wkb In Workbooks
With Wkb
'If NOT on Macro workbook then
If .Name <> ThisWorkbook.Name Then
'If the book is read-only
'don't save but close
If Not Wkb.ReadOnly Then
'Save current workbook with current workbooks cell A1 as file name
.SaveAs Filename:=(Path & "\" & Wkb.Sheets(1).Range("A1").Value & ".xls"), FileFormat:=xlExcel8
End If
'Closing here leaves the app running, but no books
.Close
End If
End With
Next Wkb
.ScreenUpdating = True
End With
End Sub
A follow up question to thread: VBA: Auto save&close out of all current workbooks except for Macro workbook
Got my answer!
Reading through Article Provided by J_V most definitely helped.
I replaced
If .Name <> ThisWorkbook.Name Then
with
If Wkb.HasVBProject = False Then
Hope this ends up helping others. Thanks again J_V!
Apreciate any help and excuse me if my terminology is incorrect.
This is a basic macro that opens a file from loacation A and copies the specified content,
It then pastes the content into the current Workbooks, specified worksheet and cell, that has run this macro.
My question is around the "FileName.csv". This is currently scheduled to be dumped in Location A "V:\Dir1\SubDir1\" periodically.
How would I go about Retrieving this file, "FileName.csv", if I started scheduling it to be dumped in loacation B "http://172.1.2.3/Dir1/SubDir1/FileName.csv" a server of some sort?
I would obviusly just like to edit the existing macro to allow for this change.
Sub CopyCSVFile1()
'workbook to copy from
WBToCopy = "FileName.csv"
'workbook path to copy from
WBpthToCopy = "V:\Dir1\SubDir1\"
'workbook to paste to
'WBToPasteTo = "ResourcesV1.xlsm" not needed here as pasting to active workbook
'workbook sheet to paste to
WBSheetToPasteTo = "Raw1"
''workbook path to paste to
'WBPthToPasteTo = "N:\Engineering\Network Performance\Capacity\SG_GG\SGSN Resources\" ' not needed here as pasting to active workbook
'range to select to copy
RangeToSelectToCopy = "A3:B149"
'cell to paste to
CellToPasteTo = "A3" ' need to work this out before assignment
Dim Merged As Object
Dim Data As Object
Set Data = ActiveWorkbook
'debug.print "ActiveWorkbook.Path = " & ActiveWorkbook.Path
Debug.Print "ActiveWorkbook.Path = " & Data.Path
Sheets(WBSheetToPasteTo).Select ' this is the sheet where you want to paste to
Workbooks.Open Filename:=WBpthToCopy & WBToCopy, local:=True
Set Merged = ActiveWorkbook ' this assigns the current active workbook to merged whish is the one I want to copy from
Range(RangeToSelectToCopy).Select ' this value just for this example should be A4 normally
Selection.Copy
Data.Activate ' this activates the Data workbook which happens to be the workbook where this macro resides
Range(CellToPasteTo).Select ' select where I want to past my data
ActiveSheet.Paste ' paste the data
Application.DisplayAlerts = False
Merged.Close 'SaveChanges = False
Application.DisplayAlerts = True
End Sub
This worked for me:
Sub CopyCSVFile1()
Dim wb As WorkBook, WBToCopy As String, WBpthToCopy As String
'workbook to copy from
WBToCopy = "test.csv"
'workbook path to copy from
WBpthToCopy = "http://127.0.0.1/testpages/"
'open the source workbook
Set wb = Workbooks.Open(WBpthToCopy & WBToCopy)
'...
'do something with wb...
'...
wb.Close False
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.