I want to transfer data from the master workbook to another workbook
If the transfer to destination.xlsx is successful
but if transfer to destination.xlsm is unsuccessful
this is my code
Private Sub CommandButton1_Click()
Dim strPath2 As String
Dim wbk As Workbook
strPath2 = "C:\destination.xlsm"
On Error Resume Next
Set wbk = Workbooks.Open(strPath2)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Master").Range("A1:A30").Copy
wbk.Worksheets("destination").[E15].PasteSpecial Paste:=xlPasteValues
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
You entire code work properly, except this part,
ThisWorkbook.Worksheets("Master").Range("A1:A30").Copy
wbk.Worksheets("destination").[E15].PasteSpecial Paste:=xlPasteValues
By using copy method, you can input destination subsequent without the need for paste special:
Sheet1.Range("A1:A5").Copy wbk.Worksheets("Sheet1").Range("A1")
Eventually it perform same step as your need with less code.
Related
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
I have an Excel file that is updated every few seconds by an application. Using the data delivered by the application, several cells in the worksheet (called "TSdata") are calculated using various formulae. If the value of a specific cell (B41) changes, the macro should write the contents of the worksheet to a CSV file.
With the help of one of the guys on superuser.com, I created a version based on Worksheet_Change that worked perfectly if the content of the cell was manually updated. I created a version using Worksheet_Calculate that I expected to work the same way when the cell value was changed by the formula.
This is the code I used:
Private Sub Worksheet_Calculate()
If Worksheets(“TSdata”).Range(“B41”).Value<>prevval Then
Call ExportWorksheetAndSaveAsCSV
End If
prevval = Worksheets(“TSdata”).Range(“B41”).Value
End Sub
Public Sub ExportWorksheetAndSaveAsCSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Set shtToExport = ThisWorkbook.Worksheets("TSdata") 'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False 'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\TSCSV\TSCSV1.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
FileCopy "C:\TSCSV\TSCSV1.csv", "C:\ChartInfo\Data\TSCSV2.csv"
End Sub
I know from the earlier test using a manual update that the Public Sub works OK (It's copied from another query regarding writing CSV files) but when I launch the macro, it seems to attempt multiple updates (the screen blinks several times) and then crashes Excel. So, obviously something in the Private Sub is incorrect, but I've based it on other responses to similar questions, so I'm at a loss to figure out what's wrong/missing.
Note: the FileCopy at the end of the Public Sub is so that another program can work on the CSV without disrupting the Excel updates.
Thanks in advance for any help.
Copying a worksheet to no location creates a new workbook with a single worksheet that is a copy of the original.
Public Sub ExportWorksheetAndSaveAsCSV()
Dim fn1 As String, fn2 As String
fn1 = "C:\TSCSV\TSCSV1.csv"
fn2 = "C:\ChartInfo\Data\TSCSV2.csv"
'copying a ws to no location creates a new workbook with a single worksheet
ThisWorkbook.Worksheets("TSdata").Copy 'Sheet to export as CSV
Application.DisplayAlerts = False 'Possibly overwrite without asking
With ActiveWorkbook
.SaveAs Filename:=fn1, FileFormat:=xlCSV
.Close SaveChanges:=False
End With
Application.DisplayAlerts = True
On Error Resume Next
If CBool(Len(Dir(fn2))) Then Kill fn2
FileCopy fn1, fn2
On Error GoTo 0
End Sub
Just doing something at work, and trying to reference a file on a network directory on VBA.
Sub CostPriceMain()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
NewFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files
(*.xlsx; *.xls), (*.xlsx; *.xls), All Files, *.*", FilterIndex:=1)
If NewFile = False Then Exit Sub
If NewFile <> False Then
Set wkbk = Workbooks.Open(NewFile)
End If
Dim Sh As Worksheet
For Each Sh In wkbk.Worksheets
If Sh.Visible = True Then
Sh.Activate
Sh.Cells.Copy
Workbooks("S:\Stafford\WK24 WH.xls").Sheets("Name").Range("A1").PasteSpecial Paste:=xlValues
End If
Next Sh
Application.CutCopyMode = False
ActiveWorkbook.Close True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Done = MsgBox("Task Complete", vbOKOnly)
End Sub
I'm trying to open it so that that I can paste data from wkbk into it. However I keep getting a 'Microsoft Office Excel cannot access the file' runtime error 1004.
Is this an issue because the file is not stored locally? As I'm scratching my head at this.
Try this:
Sub CostPriceMain()
Dim SourceWkb As Workbook
Dim TargetWkb As Workbook
Dim SourceWksht As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
NewFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files (*.xlsx; *.xls), (*.xlsx; *.xls), All Files, *.*", FilterIndex:=1)
If NewFile = False Then Exit Sub
If NewFile <> False Then
Set SourceWkb = Workbooks.Open(NewFile)
End If
Set TargetWkb = Workbooks.Open("S:\Stafford\WK24.xls") ' warning - XLS file could cause problems - see note
For Each SourceWksht In SourceWkb.Worksheets
If SourceWksht.Visible Then
SourceWksht.Copy After:=TargetWkb.Sheets(TargetWkb.Sheets.Count)
End If
Next SourceWksht
TargetWkb.Close True
SourceWkb.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Done = MsgBox("Task Complete", vbOKOnly)
End Sub
I notice your "wk24" is an XLSfile, yet you invite the user to choose XLSor XLSX files to import from. You can't import an XLSX file into an XLS file using this method. I'd suggest changing your target file to WK24.XLSX
You open your workbook within the loop which means it will try and open it for every sheet - and throw an error when it's already open.
Open the workbook before you start looping and then just reference it. This code will copy each visible sheet from the workbook containing the code to WK24.xls (note, no activating of sheets required):
Sub Test()
Dim wrkBk As Workbook
Dim wrkSht As Worksheet
Set wrkBk = Workbooks.Open("S:\Stafford\WK24.xls")
For Each wrkSht In ThisWorkbook.Worksheets
If wrkSht.Visible Then
'Copy sheet.
wrkSht.Copy After:=wrkBk.Sheets(wrkBk.Sheets.Count)
End If
Next wrkSht
End Sub
Edit:
I've made a few changes to your posted code.
I removed If NewFile = False Then Exit Sub - If NewFile isn't false it will run the code, otherwise it jumps straight to the end. It provides a single exit point for your procedure.
I updated ActiveWorkbook.Close True to your referenced workbooks. ActiveWorkbook may not always be the correct book - always best to avoid Active or Select... if you find yourself using either (or Activate or Selected or anything similar) then you're probably making more work for yourself.
Your MsgBox isn't going to act on any response, it's just informing you so no need to set it to a variable.
If you're still finding it says the workbook isn't accessible then triple check the file location, file name, whether it's already open.
Which file is causing the problem? NewFile or WK24?
Also - are you copying the whole sheet, cells from the sheet, copy & pastespecial - you keep changing your code.
Sub CostPriceMain()
Dim NewFile As Variant
Dim wkbk As Workbook
Dim wrkBk As Workbook
Dim wrkSht As Worksheet
NewFile = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files (*.xlsx; *.xls), (*.xlsx; *.xls), All Files, *.*", FilterIndex:=1)
If NewFile <> False Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wkbk = Workbooks.Open(NewFile)
Set wrkBk = Workbooks.Open("S:\Stafford\WK24.xls")
For Each wrkSht In wkbk.Worksheets
If wrkSht.Visible Then
'Copy all cells with formula, etc.
'wrkSht.Cells.Copy Destination:=wrkBk.Worksheets("Sheet1").Range("A1")
'Copy and pastespecial all cells.
'wrkSht.Cells.Copy
'wrkBk.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
'Copy whole sheet to WK2 (Sheets includes ChartSheets)
wrkSht.Copy After:=wrkBk.Sheets(wrkBk.Sheets.Count)
End If
Next wrkSht
wrkBk.Close True 'Closes WK24.
wkbk.Close False 'Closes your chosen file without saving.
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Task Complete", vbOKOnly
End If
End Sub
I have a simple macro that opens a csv file and supposed to copy a cell in the working Workbook:
Sub macro1()
Dim build_w As Workbook
Dim build_s As Worksheet
Dim folder_st As String
Application.ScreenUpdating = False
folder_st = "c:\file.csv"
Set build_w = Application.Workbooks.Open(folder_st)
Set build_s = build_w.Sheets("build")
build_s.Range("A1").Copy
ActiveSheet.Paste Range("A284")
build_w.Close True
Application.ScreenUpdating = True
End Sub
If I comment out the line build_s.Range("A1").Copy everything is fine, but If I leave this in, Excel crashes every single time.
Any suggestions?
Are you aware that the ActiveSheet at the moment you paste is itself the build_s worksheet? This is the problem when working with stuff like Activesheet. It is always preferable to specify worksheet and workbook objects precisely, without counting on what is active at a given moment.
Eventually, to get the behavior you want, you should do:
build_s.Range("A1").Copy ThisWorkbook.ActiveSheet.Range("A284")
Have you tried handling any possible errors with:
On Error GoTo MyHandler
MyHandler:
PFB for the require code. CSV file cannot have multiple sheets so that's why it must be crashing. CSV files can have only one sheet in it, so no need to specify sheet name.
Sub macro1()
'Declared variables
Dim build_w As Workbook
Dim folder_st As String
'Disabling screen updates
Application.ScreenUpdating = False
'Initializing the file name
folder_st = "c:\file.csv"
'Opening the workbook
Set build_w = Workbooks.Open(folder_st)
'Copying the value of cell A1
Range("A1").Copy
'Selecting the cell A284
Range("A284").Select
'Pasting the copied value
ActiveSheet.Paste
'Saving the workbook by saving the .CSV file
build_w.Close True
'Enabling screen updates
Application.ScreenUpdating = True
End Sub
it's because upon opening csv file it becomes the Active workbook and its only worksheet the Active worksheet
you can exploit this at your advantage like follows:
Option Explicit
Sub macro1()
Dim folder_st As String
Application.ScreenUpdating = False
folder_st = "c:\file.csv"
With ActiveSheet '<--| reference your currently active sheet before opening csv file
Application.Workbooks.Open(folder_st).Sheets("build").Range("A1").Copy '<--| open csv file (and it becomes the Active Workbook) and reference its "build" sheet range "A1" and copy it...
.Range("A284").PasteSpecial '<--| paste it to your referenced sheet range A284
Application.CutCopyMode = False '<--| release clipboard
ActiveWorkbook.Close False '<--| close Active workbook, i.e. the csv file
End With
Application.ScreenUpdating = True
End Sub
Related: Save each sheet in a workbook to separate CSV files
I’ve inherited some code that I’m trying to update. The intention is to take a particular range from each of certain (macro-generated) sheets and save them as distinct CSV files. Here’s the existing code, somewhat simplified & with error checking removed:
' Save sheets not named "Table" as CSV files
Sub Extract_CSV()
Dim CurrentSheet As Integer
For CurrentSheet = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(CurrentSheet).Activate
With ActiveWorkbook.Worksheets(CurrentSheet)
If (.Name <> "Table") Then
.Range("J3:J322").Select
.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True
End If
End With
Next CurrentSheet
End Sub
The line .Range("J3:J322").Select is a noop in this context, but how can I achieve what this was trying to do: save only the range J3:J322 to this new CSV file?
I've augmented your code and added comments. This code creates a temporary workbook to copy/paste your selection and save it. The temporary workbook is then closed. Note that this code will overwrite existing files without prompts. If you wish to see prompts, then remove the Application.DisplayAlerts lines before and after the loop.
Sub Extract_CSV()
Dim wb As Workbook
Dim CurrentSheet As Integer
For CurrentSheet = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(CurrentSheet).Activate
'Suppress Alerts so the user isn't prompted to Save or Replace the file
Application.DisplayAlerts = False
With ActiveWorkbook.Worksheets(CurrentSheet)
If (.Name <> "Table") Then
'Select the range and copy it to the clipboard
.Range("J3:J322").Select
Selection.Copy
'Create a temporary workbook and paste the selection into it
Set wb = Application.Workbooks.Add
wb.Worksheets(1).Paste
'Save the temporary workbook with the name of the the sheet as a CSV
wb.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True
'Close the workbook
wb.Close
End If
End With
'Restore alerts
Application.DisplayAlerts = True
Next CurrentSheet
End Sub
You may copy the target range, paste it in a new worksheet (you may need to paste as values, and paste number format as well), and then save that worksheet.
The code below embodies the idea. Lines commented with '* are added/modified as compared to your code. A few things to bear in mind:
By pasting values, you prevent the (unlikely) case of having cells with functions whose evaluated value changes upon pasting in the newly created workbook.
Using rng instead of selecting the Range is the recommended practice. If you do not have a lot of these operations, you would likely not notice the (minor) time saving.
Disabling DisplayAlerts eliminates alerts during macro execution (please see this to find out if you would like to make adjustments).
' Save sheets not named "Table" as CSV files
Sub Extract_CSV()
Dim CurrentSheet As Integer
For CurrentSheet = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(CurrentSheet).Activate
Application.DisplayAlerts = False '*
With ActiveWorkbook.Worksheets(CurrentSheet)
If (.Name <> "Table") Then
'.Range("J3:J322").Select
Dim rng As Range '*
Set rng = .Range("J3:J322") '*
rng.Copy '*
Dim wb As Workbook '*
Set wb = Application.Workbooks.Add '*
wb.Worksheets(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False '*
wb.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True '*
wb.Close '*
End If
End With
Application.DisplayAlerts = True '*
Next CurrentSheet
End Sub