I need to copy paste all my Worksheet name in the current workbook to a new workbook with same worksheet names. (without the datas. I only need the worksheet names.)
I tried following VBA but it shows the error
"The name is already taken." (Runtime Error 1004)
'Create new work book for Pivot
Dim Source As Workbook
Dim Pivot As Workbook
Set Source = ActiveWorkbook
Set Pivot = Workbooks.Add
Dim ws As Worksheet
For Each ws In Worksheets
'Create new worksheet in new excel
Dim Line As String
Line = ActiveSheet.Name
Pivot.Activate
Sheets.Add
ActiveSheet.Name = Line
Source.Activate
Next
You never use ws so Line never changes. Also you do not need to select or activate anything. Finally, you should qualify your Worksheets etc with the workbook they come from.
Dim Source As Workbook
Dim Pivot As Workbook
Set Source = ActiveWorkbook
Set Pivot = Workbooks.Add
Dim ws As Worksheet
For Each ws In Source.Worksheets
Pivot.Worksheets.Add.Name = ws.Name
Next
That will not protect you from a situation where there is already a sheet in the new workbook with the name identical to one of your sheets name (e.g. Sheet1), and it will leave any sheets the new workbook has by default (controlled by the Application.SheetsInNewWorkbook property).
Related
I keep getting an Out of Range error when trying to copy a sheet from on workbook to another. The original spreadsheet (Master_Data.xlsm) is what is running the vba script. The scripts opens another spreadsheet, manipulates it, then copies the final sheet to be pasted in the Master_Data.xlsm Workbook.
Sub Result_Scrapper()
Dim wb As Workbook, ws As Worksheet, wbFile As Object
Dim masterBook As Workbook
Dim wsa As Worksheet
Dim year As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("C:\Users\Output_Spreadsheets\")
Set masterBook = Excel.Workbooks("Master_Data.xlsm")
Application.ScreenUpdating = False
For Each wbFile In fldr.Files
If fso.GetExtensionName(wbFile.Name) = "xlsm" Then
Set wb = Workbooks.Open(wbFile.Path)
'Copy sheet of interest
ActiveSheet.Copy 'Before:=ThisWorkbook.Sheets(“A”) 'tried doing it using before statement but it also caused errors
'paste sheet into masterBook spread--this is where the error comes
masterBook.Sheets(Sheets.Count).Paste
End If
masterBook.Sheets("master").Name = Right([A2], 30)
Next wbFile
There are two issues. First, as someone else commented, you need to fully qualify the count. Second, you'll want to do it on one line; and you could do before, but then you're just pushing out whatever that last sheet is, if you add it after, then the sheets stay in order.
Try:
ActiveSheet.Copy After:=masterBook.Sheets(masterBook.Sheets.Count)
I have two excel files, one with multiple excel worksheet with each month as worksheet name, for month Aug, it will have 8 worksheets, for Oct it will have 10 worksheets and so on. The other excel which is the excel file that I'm working on it, i need to import last worksheet from the monthly excel file into this excel as the first worksheet because there are macro code need it to be in first worksheet.
In short, import duplicate/'create new copy' of last sheet (worksheet name always change) to another workbook as first worksheet.
Dim wbCopy As Workbook
Dim wsCopy As Worksheet
Dim rngCopy As Range
Dim wbPaste As Workbook
Dim wsPaste As Worksheet
Dim rngPaste As Range
Set wbPaste = ActiveWorkbook
Set wbCopy = Workbooks.Open("O:\abc\Inventory\Monthly.xlsm")
Set wsCopy = wbCopy.Worksheets("Sheet1") 'Question- how to always select last worksheet?
Set rngCopy = wsCopy.Range("a:aa").EntireColumn 'Question- can i duplicate a copy of worksheet ?
Set wsPaste = wbPaste.Worksheets("Order Quantities")
Set rngPaste = wsPaste.Range("a1") 'Question- this just paste into "Order Quantities", but how to move or duplicate the worksheet into first worksheet in excel workbook. ?
rngCopy.Copy
rngPaste.PasteSpecial
Workbooks.Application.CutCopyMode = False
Workbooks("Monthly.xlsm").Close False
Worksheets.count will give you the index of the last worksheet in the queue.
dim wbPaste as workbook
Set wbPaste = ActiveWorkbook
with Workbooks.Open("O:\abc\Inventory\Monthly.xlsm", readonly:=true)
.workSheets(.Worksheets.count).Copy Before:=wbPaste.Sheets(1)
.close savechanges:=false
end with
'optionally rename the new imported worksheet
wbPaste.workSheets(1).name = "abc"
The goal here is to set a worksheet object, then move that worksheet to a new workbook and continue to use that worksheet object. However, by moving that worksheet it appears that the worksheet object previously associated with it is lost.
To test:
Lets say we have two excel workbooks in the same folder named Book1.xlsb and Book2.xlsb each with one sheet in them named Sheet1. When we open Book1 we put in the below sub and try to move a sheet from the other using a worksheet object.
Everything "works", but the worksheet object is lost in the process, and throws an error as soon as you try to use it again. Is it possible to move the worksheet to a new workbook and not lose that worksheet object association so that it can be referenced later?
Option Explicit
Sub test()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws As Worksheet
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("Book2.xlsb")
Set ws = wb2.Sheets(1)
ws.Name = "Sheet2" 'name changed to avoid conflict with the one already there
ws.Move wb1.Sheets(1)
MsgBox ws.Name 'this line throws an error, indicating that ws association has been lost
End Sub
Edit:
If this is not possible, how can we reliably re-set that worksheet object to the one that we just moved?
To reset the ws object:
Set ws = wb1.WorkSheets("Sheet2")
If you dont know the name, you know it was moved to the last position, right?
Set ws = wb1.WorkSheets(wb1.WorkSheets.Count)
If it was moved to the first position, then:
Set ws = wb1.WorkSheets(1)
In your code
ws.Move wb1.Sheets(1)
You alreay moved the sheet ws to the first sheet of the Book2.xlsb file
"Sheets(1)" means the first sheet of the file
So you can reset ws like this.
Set ws = wb1.Sheets(1)
I am trying to create a copy of a large macro enabled (xlsm) file in xlsx format.
Sub Button1_Click()
Dim wb As Workbook
Set wb = Workbooks.Open("C:\original.xlsm")
Dim mySheetList() As String
ReDim mySheetList(0 To (ThisWorkbook.Sheets.Count) - 1)
Dim a As Integer
a = 0
For Each ws In ActiveWorkbook.Worksheets
mySheetList(a) = ws.Name
a = a + 1
Next ws
'actually save
Worksheets(mySheetList).Copy
ActiveWorkbook.SaveAs Filename:="ORIGINAL_COPY.xlsx" 'default ext
wb.Close
End Sub
I am getting subscript out of range error at following line:
mySheetList(a) = ws.Name
You are sizing the array with ThisWorkbook.Sheets but the loop use ActiveWorkbook.Worksheets. You need the same reference to avoid issues when multiple workbooks are opened.
You're using 4 different references to workbooks:
wb, ThisWorkbook and ActiveWorkbook are not necessarily the same thing. Furthermore, when you use Worksheets without prefixing it with a workbook reference, you're implicitly referencing the Activeworkbook. And, when you use Worksheets.Copy without any arguments, you're implictly creating a new workbook.
Currently, if ThisWorkbook has fewer sheets than original.xlsm, then your array will not be large enough to accommodate indexes larger than the count of sheets in ThisWorkbook. That is what is causing your out of bounds error.
I've adjusted the code. This will open the XLSM, copy the sheets, save the new XLSX workbook, and close the original XLSM, leaving the new XLSX workbook open.
Sub Button1_Click()
Dim wbOriginal As Workbook
Dim wbOutput As Workbook
Set wbOriginal = Workbooks.Open("C:\original.xlsm")
Dim mySheetList() As String
ReDim mySheetList(0 To (wbOriginal.Sheets.Count) - 1)
Dim a As Integer
a = 0
For Each ws In wbOriginal.Worksheets
mySheetList(a) = ws.Name
a = a + 1
Next ws
'Unfortunately, Worksheets.Copy isn't a function, so it doesn't
'return the workbook that it creates, so we have to execute the
'copy, then find the activeworkbook
Worksheets(mySheetList).Copy
Set wbOutput = ActiveWorkbook
'actually save
wbOutput.SaveAs Filename:="ORIGINAL_COPY.xlsx" 'default ext
wbOriginal.Close
End Sub
Why bother with all that looping?
Sub MM()
Dim sourceWB As Excel.Workbook
Set sourceWB = Workbooks.Open("C:\Original.xlsm")
sourceWB.SaveAs "C:\ORIGINAL_COPY.xlsx", FileFormat:=xlOpenXMLWorkook
sourceWB.Close False '// Optional
End Sub
The .SaveAs() method would be far more effective.
As mentioned in other answers, your issue seems to be with wb, ActiveWorkbook and ThisWorkbook being used interchangeably when they are actually different things.
wb is a workbook object that has been set to "C:\original.xlsm". It will always refer to that workbook unless you close the workbook, empty the object, or assign a new object to it.
ActiveWorkbook refers to the workbook that is currently active in Excel's forefront window. (i.e. The workbook you can see on your screen)
ThisWorkbook refers to the workbook in which the currently executing code belongs to. To quickly explain the difference:
Workbook A is the only workbook open, and has some code in to open another workbook (let's call it Workbook B).
At the moment, Workbook A is the ActiveWorkbook.
The code in workbook A starts running, workbook A is now the ActiveWorkbook and ThisWorkbook (because the running codes resides in this workbook)
The code opens Workbook B, which naturally opens in the forefront of Excel. Now Workbook B is the ActiveWorkbook and Workbook A is still the ThisWorkbook
Hopefully that clears it up a bit for you...
I would like to be able to
take a sheet called "data" in a given workbook called
"original_data.xlsm",
copy it conditionally (using Autofilter or
something else), say only those rows where column C was "dog"
Create a new workbook, in the same folder as the original book, called dog.xlsm and save the copied stuff into
a new sheet called "dog data".
Then repeat with a different filter.So for example copy and
autofilter if column C was "cat" and create a workbook "cat.xlsm", in the same folder as the original book, with a sheet called "cat_data" containing some filtered data.
I've been making incorrect attempts for three days now and would appreciate some help. Here is what I have done so far.
Workbooks.Add
Set wb = ActiveWorkbook
GetBook = ActiveWorkbook.Name
wb.Sheets("data").SaveAs Workbooks(GetBook).Path & "\dog"
Workbooks("dog.xlsx").Worksheets("Sheet1").UsedRange.AutoFilter Field:=3, Criteria1:="=dog"
But it's not working. :(
Looks like you're trying to set wb to "original_data.xlsm", but your first line is making the new workbook the active workbook.
Workbooks.Add
Set wb = ActiveWorkbook
See if this helps.
Sub sheetCopy()
Dim wbS As Workbook, wbT As Workbook
Dim wsS As Worksheet, wsT As Worksheet
Set wbS = ThisWorkbook 'workbook that holds this code
Set wsS = wbS.Worksheets("Data")
wsS.Copy
Set wbT = ActiveWorkbook 'assign reference asap
Set wsT = wbT.Worksheets("Data")
wsT.Name = "Dog Data" 'rename sheet
wbT.SaveAs wbS.Path & "\dog.xlsx" 'save new workbook
wsT.UsedRange.AutoFilter Field:=3, Criteria1:="=dog"
End Sub