I'm currently trying to merge 24 workbooks into one workbook with 24 sheets. Workbooks are named run 1 to run 24 and I am trying to merge into a template which already has 2 sheets named summary and pressure. I'm very new to coding for this and any copied code from other questions doesn't seem to work for me. I attempted the record macros where I moved into the template but when trying to apply this it comes up with a run time error 9. The coding looks like this.
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Workbooks("Current Template.xlsx").Sheets(2)
Sheets("Sheet1").Select
Sheets("Sheet1").Move After:=Workbooks("Current Template.xlsx").Sheets(3)
End Sub
Any help would be greatly appreciated.
Cheers
This might be able to help you:
Sub test()
Dim wb As Workbook
Set wb = Application.Workbooks("target.xlsm") 'Considering that macro is placed in your target file
i = 1
While i < 25
Workbooks.Open ("run" & i & ".xlsx") 'give path as applicable
Set wb1 = Application.Workbooks("run" & i & ".xlsx")
With wb1
.Sheets("sheet1").Copy After:=wb.Sheets(wb.Sheets.Count) 'the new sheet will be placed after the last sheet in target file
.Close
End With
i = i + 1
Wend
End Sub
Related
Wrote some code below to help me save some time saving files, the below is the shorter version which only saves one worksheet.
Sometimes it works perfectly, but most of the time it just silently crashes Excel with no error warning.
Nothing wrong while debugging... Not sure if ThisWorkbook.Sheets might be causing the issue?
Sub Save_CPC()
'Define the sheets to copy
Dim sheetsToCopy As Variant
sheetsToCopy = Array("RWF CPC")
'Create a new workbook
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add
'Loop through the sheets to copy
For i = 0 To UBound(sheetsToCopy)
'Copy the sheet to the new workbook
ThisWorkbook.Sheets(sheetsToCopy(i)).Copy Before:=newWorkbook.Sheets(1)
Next i
'Break links in the new workbook
newWorkbook.BreakLink Name:=ThisWorkbook.Name, Type:=xlExcelLinks
'Hide the sheet Sheet1 in new workbook
newWorkbook.Sheets("Sheet1").Visible = False
'Save the new workbook in the original folder
Dim saveName As String
saveName = ThisWorkbook.Sheets("Macros").Range("B13").Value
newWorkbook.SaveAs ThisWorkbook.Path & "\" & saveName & ".xlsx"
End Sub
Thanks in advance!!
Should copy and save worksheet as new spreadsheet with given name in current folder.
Copy Worksheets To a New Workbook
In One Go
Note that you can copy all the worksheets in one go as suggested by BigBen in the comments:
ThisWorkbook.Sheets(sheetsToCopy).Copy
Dim NewWorkbook As Workbook: Set NewWorkbook = Workbooks(Workbooks.Count)
The major drawback is that the worksheets in the new workbook will appear in the order they are appearing in the old workbook which may not necessarily be the order they are appearing in the array.
Additionally, at least one of the worksheets needs to be visible, and very hidden worksheets will not be copied.
Loop
Option Explicit
Sub SaveCPC()
' Start error-handling routine.
On Error GoTo ClearError
' Populate an array with the names of the worksheets to copy.
Dim sheetsToCopy() As Variant: sheetsToCopy = VBA.Array("RWF CPC")
' 'VBA.' ensures a zero-based array no matter what ('Option Base'-related).
' If you don't do this, instead of both occurrences of '0',
' use the recommended (more accurate) 'LBound(sheetsToCopy)'.
' Declare new variables to be used in the loop.
Dim NewWorkbook As Workbook, OldWorksheet As Worksheet, i As Long
' Loop through the worksheet names in the array.
For i = 0 To UBound(sheetsToCopy)
' Reference the worksheet to be copied.
Set OldWorksheet = ThisWorkbook.Sheets(sheetsToCopy(i))
If i = 0 Then ' on the first iteration...
' Add a new workbook containing only the first copied worksheet.
OldWorksheet.Copy
' Reference this new workbook.
Set NewWorkbook = Workbooks(Workbooks.Count)
Else ' on any but the first iteration
' Copy the worksheet as the last sheet in the new workbook.
OldWorksheet.Copy After:=NewWorkbook.Sheets(NewWorkbook.Sheets.Count)
End If
Next i
' Break links in the new workbook.
NewWorkbook.BreakLink Name:=ThisWorkbook.Name, Type:=xlExcelLinks
' Retrieve the base name of the new workbook.
Dim saveName As String
saveName = ThisWorkbook.Sheets("Macros").Range("B13").Value
' Save the new workbook in the original folder.
Application.DisplayAlerts = False ' overwrite without confirmation.
NewWorkbook.SaveAs ThisWorkbook.Path & "\" & saveName
Application.DisplayAlerts = True
' Inform.
MsgBox "CPC saved.", vbInformation
ProcExit:
Exit Sub
ClearError:
' Continue error-handling routine.
MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf & Err.Description
Resume ProcExit
End Sub
I just started learning VBA so please advise.
I have one Macro(master workbook) where I would like to import/copy worksheets from 5 different workbook.
So each of these 5 workbook contain different sheets out of which i would like to import/copy only one or particular sheets. These imported sheets should be marked as "Sheet 1(for data from workbook 1), Sheet 2(for data from workbook 2) and similarly in master workbook.
I have all of this Workbooks in one folder. This folder changes every week so i cannot give folder path. Rather i want the flexibility to Browse folder.
Thanks in advance for your help.
Example code of how to import all the sheets from an external workbook with browser:
Sub shCopy()
Dim fName As String, wb As Workbook
fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)
For Each sh In wb.Sheets
sh.Copy Before:=ThisWorkbook.Sheets(1)
Next
wb.Close False
End Sub
Now you just need to specify the conditions on what sheet to actually copy, and name it accordingly.
Pretty sure we shouldn't be adding questions as answers. Next time you should probably make a new question.
But I can't see much deviation between the loops, and you are on the right track. But you don't actually need the If since everything within the loop will repeat each loop anyway.
The number for the file dialouge can be inserted with the i variable using the & operator.
Sub shCopy()
Dim fName As String, wb As Workbook, i As Integer
For i = 1 To 3
MsgBox "Select file " & i
fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)
Sheets("Sheet1").Copy After:=Workbooks("mymacro.xlsm").Sheets(Workbooks("mymacro.xlsm").Sheets.Count)
ActiveSheet.Name = "Sheet" & Sheets.Count
wb.Close False
Next i
End Sub
I want to update this code so it copies the values to a new workbook in csv format instead of sheet2 on same workbook. Thanks
Option Explicit
Dim TimeToRun
Sub chkTimer()
Application.DisplayAlerts = False
TimeToRun = Now + TimeValue("00:00:10")
Application.OnTime TimeToRun, "runMacro"
Application.DisplayAlerts = True
End Sub
Sub runMacro()
Calculate
Sheet1.Range("A1:D12").Copy
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
chkTimer
End Sub
Sub stopMacro()
On Error Resume Next
Application.OnTime TimeToRun, "runMacro", , False
End Sub
Here is basic code to create a new workbook and transfer your range to Sheet1 in the new workbook, no copy/paste. It will save the new workbook, as an .xlsx file, to the same folder your macro enable workbook is located, using Thisworkbook.Path. Then name the new workbook "Test", change name as needed. Comments provided in the code.
Replace these two lines...
Sheet1.Range("A1:D12").Copy
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
With...
Dim newWB As Workbook: Set newWB = Workbooks.Add 'create new workbook
With newWB
'You Don't need to Copy/Paste, use the equals method to get the values
.Sheets(1).Range("A1:D12").Value = ThisWorkbook.Sheets("Sheet1").Range("A1:D12").Value
'Save the new workbook to the same folder ThisWorkbook is located
.SaveAs Filename:=ThisWorkbook.Path & "\" & "Test" & ".xlsx", FileFormat:=51
End With
Thank you, this is easy and excellent. One issue though, when replaced with new code its trying to save a new Test workbook every 10 seconds instead of appending in one sheet. Also, could we create the destination workbook in .csv format? Appreciate your help.
I really appreciate if someone here would help me crack this problem which i cant find the solution (and sorry for my bad english).
So i have multiple excels in one folder. every excel in it have same format 1st sheet for reference of every sheet, 2nd sheet for consolidation data, and 3rd sheet and the rest for the data to be consolidated. Every excel in the folder have various amount of sheet.
What i want to do is i want to copy data from range A27:AJ500 that begin from 3rd sheet to every sheet after, into another new workbook in sheet1 and paste it begin from cell A27 over and over into the bottom and looping for every excel in folder.
i dont have enough ability yet to write my own script but i managed to understand some and combine it into this script.
Sub Download_Data()
Path = "C:\Users\ASUS\Desktop\Done\"
Filename = Dir(Path & "*.xlsm")
'to open every excel in my folder
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True '--> i only managed to do it right till here
'supposed to copy range in every sheet of excel in my folder into different workbook
For Each ws In thiswoorkbook.Worksheets '--> i try write this code but i am confused to do what i want from here and i know this code is nowhere near true
With ws
If .Name <> "GABUNGAN" Then
range("A27:AJ500").Select
Selection.copy
Workbooks("Tes.xlsm").range("A27").PasteSpecial Paste:=xlPasteValues
End If
End With
Next ws
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.Goto ActiveWorkbook.Sheets("sheet1").range("A1")
End Sub
I've been searching for the code not only i cant customize it to this code but also i cant understand what is wrong in the code therefore i write this question. Any help will be appreciated, thanks in advance for your attention wish you safe and sound.
Try this: (tested)
Dim sourcewb As Workbook
Dim destwb As Workbook
Dim y As Long
Dim ws As Worksheet
Dim strPath As String, strFilename As String
strPath = "C:\Users\ASUS\Desktop\Done\"
strFilename = Dir(strPath & "*.xlsm")
y = 27
Set destwb = ThisWorkbook
Do While strFilename <> ""
Set sourcewb = Workbooks.Open(Filename:=strPath & strFilename, ReadOnly:=True)
For Each ws In sourcewb.Worksheets
With ws
If .Name <> "name of reference sheet" And .Name <> "name of consolidation sheet" Then
.Range("A27:AJ500").Copy
destwb.Worksheets("sheet1").Range("A" & y).PasteSpecial Paste:=xlPasteValues
y = y + (500 - 27) + 1
End If
End With
Next ws
sourcewb.Close False
strFilename = Dir()
Loop
I'm trying to implement a simple Excel-VBA Macro to have the user browse for another workbook in the file explorer, and then have certain cells in that workbook copied into my active workbook. Here's my short code:
Sub Load_AutoCADBOM()
Dim wbk As Workbook
Dim MyFile As String
MyFile = Application.GetOpenFilename()
If MyFile <> "False" Then
Set wbk = Workbooks.Open(MyFile)
With wbk.Sheets(1)
Range("B2:C43").Copy
End With
ActiveWorkbook.Close
With ThisWorkbook.Worksheets("Config")
Range("A6:B47").PasteSpecial Paste:=xlPasteValues
End With
End If
End Sub
The macro is meant to copy cells from (B2:C43) from the selected workbook and copy them into cells (A6:B47) on sheet "Config" of my current workbook. When I run the macro I get "Run-time error '1004': PasteSpecial method of Range class failed." The debugger highlights the line:
Range("A6:B47").PasteSpecial Paste:=xlPasteValues
I've tried copying from csv, xls & xlsm files all with the same result. Could it possibly be the way my cells are formatted in the sheet I'm pasting to? The funny this is I've used this macro in another workbook and had it work no problem.
If anyone knows of any way I can fix my code and get it working, it would be much appreciated.
Thankyou
End Sub
If you just want to copy values then you can skip the copy/paste and set the values directly from the source range:
Sub Load_AutoCADBOM()
Dim wbk As Workbook
Dim MyFile As String
MyFile = Application.GetOpenFilename()
If MyFile <> "False" Then
Set wbk = Workbooks.Open(MyFile)
With wbk.Sheets(1).Range("B2:C43")
ThisWorkbook.Worksheets("Config").Range("A6").Resize(.rows.count, .columns.count).value = .Value
End With
wbk.Close
End If
End Sub