I have a query in my sheet. I need to export the query range into a new .xlsx workbook to a variable folder (SaveAs).
How can I SaveAs a specific range?
I tried the Application.FileDialog(msoFileDialogSaveAs), which does save the entire workbook, but I just want to save a specific range of the workbook.
Sub SaveAsDialog()
On Error Resume Next
With Application.FileDialog(msoFileDialogSaveAs)
If .Show = 0 Then
Exit Sub
End If
Application.DisplayAlerts = False
.Execute
Application.DisplayAlerts = True
End With
End Sub
You are looking for something like this:
Copy and paste the data in a new Workbook and Save it
Sub SaveAsDialog()
Dim od As Workbook, nod As Workbook
Set od = ThisWorkbook
'Copy data that you want to save
od.Worksheets("Sheet1").Range("A1:B10").Copy
' Add a new workbook
Set nod = Workbooks.Add
nod.Worksheets(1).Range("A1").PasteSpecial xlPasteValues
'Save the new workbook
nod.SaveAs od.Path & "\New_Book.xlsx"
nod.Close True
End Sub
Related
I have an Excel-File in which the user can click on a button to save a version without formulas and only with values.
So far I use this VBA for it:
Sub Create_version_with_values_only()
Dim b As Worksheet
For Each b In Worksheets
b.Cells.Copy
b.Cells.Cells.PasteSpecial Paste:=xlPasteValues
Next b
Application.CutCopyMode = False
ActiveWorkbook.SaveCopyAs "G:\Folder\test.xlsm"
ThisWorkbook.Close SaveChanges:=False
End Sub
This VBA itself worsk fine.
However, the issue is that I have to close the file after the value-version of the file is created because the original version will not be available anymore.
Therefore, I am wondering if there is an alternative way to create the value-version of the file that makes it possible to go back to the original file afterwards.
Something like this:
Step 1) Change all formulas to values.
Step 2) Save the version with the values in the folder.
Step 3) Undo the value-replacements in original sheet without closing it.
Do you have any idea how to solve it?
There might be a more simple way to get there, but here's how you'd create a new workbook, transfer the values over and save.
Public Sub SaveValues()
Dim newWb As Workbook
Set newWb = Workbooks.Add 'create a new workbook for the values
Dim ws As Worksheet, newWs As Worksheet
For Each ws In ThisWorkbook.Worksheets
With newWb 'create worksheets and name them in new workbook
If ws.Index = 1 Then
Set newWs = .Worksheets(1)
Else
Set newWs = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
End If
newWs.Name = ws.Name
End With
With ws.UsedRange 'move values to new worksheet
newWs.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
Next
'save new workbook. If the current workbook is a .xlsb, change the .xlsm in the code below
newWb.SaveAs Replace(ThisWorkbook.FullName, ".xlsm", "_hardcoded.xlsm"), xlOpenXMLWorkbookMacroEnabled
newWb.Close
End Sub
Updated for alternatives below:
Alternative
An alternative is to use ThisWorkbook.Worksheets.Copy to copying all worksheets in one go. Unfortunately, to use this code, we have to use ActiveWorkbook to make a reference to the new workbook. (I hoped it might return a Workbook or Worksheets object)
Public Sub SaveValues2()
Dim newWB As Workbook
ThisWorkbook.Worksheets.Copy
Set newWB = ActiveWorkbook 'not great practice
Dim ws As Worksheet
For Each ws In newWB.Worksheets
With ws.UsedRange 'hardcode values
.Value = .Value
End With
Next
newWB.SaveAs Replace(ThisWorkbook.FullName, ".xlsm", "_hardcoded.xlsm"), xlOpenXMLWorkbookMacroEnabled
newWB.Close
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'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
I have written VBA code that opens up a destination workbook, copies one of the worksheets, and pastes it into the current workbook.
When I run it a second or third time etc... instead of overwriting the current worksheet, it creates a completely new one.
Ex: Worksheet is called "data", first time it transfers "data", second time "data(2)".
I have another worksheet that uses VLOOKUP function to look at some cells of this data worksheet, so it is crucial that it has correct name "data".
I thought about deleting the current (data) file before running the macro, but what if something crashes and I lose my worksheet? Is there a better solution?
NOTE: I am running the macro from the main workbook to get the sheet to be copied from the external workbook.
Sub UpdateT()
Dim wb As Workbook
Dim aw As Workbook
'Open 2nd Workbook
Set aw = Application.ActiveWorkbook
Set wb = Workbooks.Open(Filename:="C:\Users\yilmadu00\Desktop\T.xlsx")
'Copy To Different Workbook
wb.Sheets("data").Copy After:=aw.Sheets("Data1")
'Close 2nd Workbook
aw.Save
wb.Close
aw.Sheets("data").Visible = False
ActiveWorkbook.Protect ("Password")
End Sub
Function to check whether worksheet exists (credits to #ScottCrainer):
Function SheetExists(ws As String)
SheetExists = Not IsError(Application.Evaluate(ws & "!A1"))
End Function
NOTE:
It does have the issue: if A1 on the sheet contains an error it will return a false negative.
ActiveWorkbook vs ThisWorkbook, Sheets vs Worksheets
You have used 'Activeworkbook' and 'Sheet(s)' in the code so I played along.
But
Although you can have a third workbook to run the code from, I'm guessing you are running the code from a module in the 'ActiveWorkbook'. If this is true, it would be more correct to use 'ThisWorkbook' instead which always refers to the workbook that contains the code (module), to avoid accidentally running the code on a third workbook.
Sheet(s) refers to Worksheet(s) and Chartsheet(s), again I'm guessing there are no chartsheets involved in this code, therefore it would be more correct to use 'Worksheet(s)' instead of 'Sheet(s)'.
Sub UpdateT()
Const cStrPath As String = "C:\Users\yilmadu00\Desktop\T.xlsx"
Const cStrAfter As String = "Data1"
Const cStrName As String = "data"
Const cStrOld As String = "data_old"
Dim aw As Workbook '1st workbook, 'ActiveWorkbook'
Dim wb As Workbook '2nd workbook
Dim oWs As Sheet 'Each sheet in workbook 'aw'
Dim blnFound As Boolean 'True if sheet(cStrName) was found
Set aw = ActiveWorkbook 'Create a reference to the ActiveWorkbook
Set wb = Workbooks.Open(Filename:=cStrPath) 'Open 2nd Workbook
With aw
' .UnProtect ("Password")
'Check each sheet in workbook 'aw'.
For Each oWs In aw.Sheets
With oWs
'Check if there already is a sheet with the name 'cStrName'.
If .Name = cStrName Then
.Name = cStrOld 'Rename the sheet.
blnFound = True 'Sheet(cStrName) was found.
Exit For 'Immediately stop checking, there can only be one.
End If
End With
Next
End With
With wb
'Copy sheet from 2nd workbook ('wb') to workbook 'wa'.
.Sheets(cStrName).Copy After:=aw.Sheets(cStrAfter)
.Close 'Close 2nd workbook ('wb').
End With
With aw
With Application
If blnFound = True Then 'Sheet(cStrName) was found.
.DisplayAlerts = False 'Disable showing delete message.
aw.Sheets(cStrOld).Delete 'Delete old version of sheet.
.DisplayAlerts = True
End If
End With
.Sheets(cStrName).Visible = False 'Hide sheet named 'cStrName'
.Protect ("Password")
.Save 'Save workbook 'aw'.
End With
End Sub
The next time you want to do something with the sheet you have to unprotect it or the code will fail. Hidden sheets can be deleted with no problems.
I am looking for a macro to paste some data onto a moving range. I already have a cell that tells me the number of the next non empty column and this is the code I currently use:
Dim OpenFileName As String
Dim wb As Workbook
'Select and Open workbook
OpenFileName = Application.GetOpenFilename()
If OpenFileName = "False" Then Exit Sub
Set wb = Workbooks.Open(OpenFileName)
'Get data EXAMPLE
ThisWorkbook.Sheets("Teleselling 17").Range("I9:I289")*this should be dynamic, I want to paste data in a moving range*.Value = wb.Sheets("TELESELLING INBOUND").Range("L9:L289").Value
wb.Close SaveChanges:=False
MsgBox ("Done!")
Use the newly opened workbook/worksheet/range to define the scope of the value transfer.
with wb.workSheets("TELESELLING INBOUND").Range("L9:L289")
ThisWorkbook.workSheets("Teleselling 17").Range("XFD9").end(xltoleft).offset(0, 1).resize(.rows.count, .columns.count) = .value
end with