I have an excel Sub as follows
Sub btnToCsvASIN()
Dim Wb As Workbook
Dim Ds, Ws As Worksheet
Set Ds = Sheet2
Set Wb = Workbooks.Add
Set Ws = Wb.ActiveSheet
Ds.Range("A2:I100").Copy Ws.Range("A1")
Dim pKey, pId As String
Application.DisplayAlerts = False
Wb.SaveAs ThisWorkbook.Path & "\Uploader.csv", FileFormat:=xlCSV
Wb.Close
End Sub
I want to make this function generic so that no matter what the Sheet number is, it works.
So, I tried the following and other syntax also:
Function btnToCsvASIN(SheetNum as String)
Dim Wb As Workbook
Dim Ds, Ws As Worksheet
Set Ds = SheetNum
......
End Sub
My goal is to make following kind of generic function call:
btnToCsvASIN(Sheet1)
btnToCsvASIN(Sheet23)
I have been unable to make this work.
I call this Sub currently from within another macro.
Copy Range To New Workbook
Option Explicit
Sub TESTbtnToCsvASIN()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
btnToCsvASIN ws
' Or using code name:
'btnToCsvASIN Sheet1
End Sub
Sub btnToCsvASIN(ws As Worksheet)
If Not ws Is Nothing Then
Application.ScreenUpdating = False
With Workbooks.Add
ws.Range("A2:I100").Copy .ActiveSheet.Range("A1")
Application.DisplayAlerts = False
.SaveAs ThisWorkbook.Path & "\" & "Uploader", FileFormat:=xlCSV
Application.DisplayAlerts = True
'.FollowHyperlink .Path
.Close SaveChanges:=False
End With
Application.ScreenUpdating = True
End If
End Sub
Related
Hey I am quite new to VBA and I am currently trying to export tables from different sheets, if there is an alternation made to it, as CSV data. Currently my code exports all tables from my file. How can I make it export only the current table that I am executing the makro on?
Thank you for your help!
Public Sub SaveWorksheetsAsCsv()
Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
For Each xWs In Application.ActiveWorkbook.Worksheets
xWs.SaveAs xDir & "\" & xWs.name, xlCSV
Next
End Sub
I figured out a way to do it but now the window opens as a CSV file. How do i close the csv file and reopen the worksheet I was working on?
Public Sub SaveWorksheetsAsCsvUndercarriageDefinition()
Dim wbk As Workbook
Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Set wbk = Workbooks("Vba_Fehlerprüfung.xlsm")
Set xWs = wbk.Worksheets("Undercarriage Definition")
Set folder =
Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
'For Each xWs In Application.ActiveWorkbook.Worksheets
xWs.SaveAs xDir & "\" & xWs.name, xlCSV
'Next
End Sub
My suggestion would be to use the following sub in order to export a table resp. an listobject
Sub exportListobject(lo As ListObject, csvFilename As String)
Dim wbNew As Workbook
Set wbNew = Workbooks.Add
Dim wsNew As Worksheet
With wbNew
Set wsNew = wbNew.Sheets(1)
lo.Range.Copy
wsNew.Range("A1").PasteSpecial Paste:=xlPasteAll
.SaveAs Filename:=csvFilename, _
FileFormat:=xlCSVMSDOS, CreateBackup:=False
.Close False
End With
End Sub
It will copy the listobject in question into a new workbook, save it as an csv file and close it. The workbook which contains the listobject will not be touched.
If you want to export a single sheet from your workbook you can use a similar sub
Sub exportSheet(sh As Worksheet, csvFilename As String)
Dim wbNew As Workbook
Set wbNew = Workbooks.Add
Dim wsNew As Worksheet
With wbNew
sh.Copy wbNew.Sheets(1)
Set wsNew = wbNew.Sheets(1)
.SaveAs Filename:=csvFilename, _
FileFormat:=xlCSVMSDOS, CreateBackup:=False
.Close False
End With
End Sub
I have several sheets I need to copy to a new workbook and then save this workbook.
I'm using the worksheet function to copy which it seems to me like it's the intended purpose of that function.
Here's the MSDN documentation on how to do this task:
Worksheets("Sheet1").Copy
With ActiveWorkbook
.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
.Close SaveChanges:=False
End With
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.copy
This is doing exactly what I want, but it's using the ActiveWorkbook property which might cause some error, if running other codes or just working in parallel of this code running.
I'm looking for a way to manipulate the newly created workbook without having to use the ActiveWorkbook property.
Something along the lines of this:
Dim wb as Workbook
set wb = Worksheets("Sheet1").Copy
wb.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
wb.Close SaveChanges:=False
I've already tried this and it didn't work, but it's just to illustrate the point that it's not using the ActiveWorkbook property to refer to the new workbook.
Thanks in advance
From above comment:
Sub Tester()
With AsNewWorkbook(Sheet1)
Debug.Print .Name
.SaveAs "C:\Temp\blah.xlsx"
End With
End Sub
Function AsNewWorkbook(ws As Worksheet)
Dim wb As Workbook
Set wb = Workbooks.Add(xlWBATWorksheet) 'has one sheet...
With wb.Sheets(1) 'stolen from Cristian's answer...
If .Name = ws.Name Then .Name = .Name & "x"
End With
ws.Copy before:=wb.Worksheets(1)
Application.DisplayAlerts = False
wb.Worksheets(2).Delete
Application.DisplayAlerts = True
Set AsNewWorkbook = wb
End Function
#BigBen is right though - typically just using ActiveWorkbook is fine.
An improvement on #TimWilliams response so that you can copy multiple sheets at once:
Sub Test()
Dim sourceBook As Workbook
'
Set sourceBook = ThisWorkbook 'Or ActiveWorkbook or whatever book is needed
With CopySheetsToNewBook(sourceBook.Sheets(Array("Sheet1", "Sheet2")))
.SaveAs Filename:=Environ("TEMP") & "\New1.xlsx", FileFormat:=xlOpenXMLWorkbook
End With
sourceBook.Close SaveChanges:=False
End Sub
Public Function CopySheetsToNewBook(ByVal theSheets As Sheets) As Workbook
If theSheets Is Nothing Then
Err.Raise 91, "CopySheetsToNewBook", "Sheets not set"
End If
'
Dim newBook As Workbook
Dim tempSheet As Worksheet
'
Set newBook = Application.Workbooks.Add(xlWBATWorksheet)
Set tempSheet = newBook.Worksheets(1) 'To be deleted later
tempSheet.Name = CDbl(Now) 'Avoid name clashes with the sheets to be copied
'
theSheets.Copy Before:=tempSheet
Application.DisplayAlerts = False
tempSheet.Delete
Application.DisplayAlerts = True
'
Set CopySheetsToNewBook = newBook
End Function
Copy Worksheet(s) to a New Workbook
Sub NewWorkbook()
' Reference the source workbook.
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
swb.Worksheets("Sheet1").Copy ' copy one worksheet to a new workbook
'swb.Worksheets(Array("Sheet1", "Sheet2")).Copy ' copy multiple worksheets
' Reference the destination (new) workbook.
Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
Debug.Print swb.Name, dwb.Name
End Sub
I'm trying to automate the copying of 3 Excel worksheets from a master file into any other Excel file via VBA code, but I keep getting an "Error 1004: Copy Method Of Worksheet Class Failed".
Here's my code:
Sub CopyandInsert()
Application.ScreenUpdating = False
Set closedBook = Workbooks.Open("\\filepath\master_file.xlsx")
closedBook.Sheets("Long Sheet Name One").Copy After:=ThisWorkbook.Sheets(1)
closedBook.Sheets("Long Sheet Name Two").Copy After:=ThisWorkbook.Sheets(2)
closedBook.Sheets("Long Sheet Name Three").Copy After:=ThisWorkbook.Sheets(3)
closedBook.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub
VBA is able to find and open the master file, but keeps breaking at the first copy line.
Any ideas? Thank you!
Copy Sheets Using an Array of Sheet Names
Cons
All sheets have to exist.
At least one sheet has to be visible. Any hidden sheets will stay hidden.
Any very hidden sheets will not be copied.
Option Explicit
Sub CopyandInsert()
Const dFilePath As String = "C:\Test.xlsx"
Dim SheetNames As Variant
SheetNames = Array("Sheet1", "Sheet2", "Sheet3")
Application.ScreenUpdating = False
Dim dwb As Workbook: Set dwb = Workbooks.Open(dFilePath)
dwb.Sheets(SheetNames).Copy After:=ThisWorkbook.Sheets(1)
dwb.Close SaveChanges:=False
'ThisWorkbook.Sheets(1).Select
'Thisworkbook.Save
Application.ScreenUpdating = True
End Sub
Copy Sheets Using a Loop
Sub CopyandInsert2()
Const dFilePath As String = "C:\Test.xlsx"
Dim SheetNames As Variant
SheetNames = Array("Sheet1", "Sheet2", "Sheet3")
Application.ScreenUpdating = False
Dim dwb As Workbook: Set dwb = Workbooks.Open(dFilePath)
Dim dsh As Object
For Each dsh In dwb.Sheets(SheetNames)
On Error GoTo ClearWorksheetError
dsh.Copy After:=ThisWorkbook.Sheets(1)
Next dsh
dwb.Close SaveChanges:=False
'ThisWorkbook.Sheets(1).Select
'Thisworkbook.Save
Application.ScreenUpdating = True
Exit Sub
ClearWorksheetError:
MsgBox "Run-time error '" & Err.Number & "':" & vbLf & Err.Description, _
vbCritical
Resume Next
End Sub
PERSONAL.xlsb
To make it work correctly, you need to select (look at) the file where you want to add the copied sheets, then open the macro-dialog and select the CopyandInsert macro.
Option Explicit
Sub CopyandInsert()
Const dFilePath As String = "C:\Test.xlsx"
Dim SheetNames As Variant
SheetNames = Array("Sheet1", "Sheet2", "Sheet3")
Dim swb As Workbook: Set swb = ActiveWorkbook
Application.ScreenUpdating = False
Dim dwb As Workbook: Set dwb = Workbooks.Open(dFilePath)
dwb.Sheets(SheetNames).Copy After:=swb.Sheets(1)
dwb.Close SaveChanges:=False
'swb.Sheets(1).Select
'swb.Save
Application.ScreenUpdating = True
End Sub
I want to copy/paste all worksheet inlcuding the values/formula in the cells to another new workbook.
This code just copy the first ws, but not all other. How can I make sure, that all ws are gettin copied and pasted without writing all the names from the ws in the vba-code?
Sub CopyPaste()
Dim ws As Worksheet, wb As Workbook
Set ws = ActiveSheet
Set wb = Workbooks.Add(xlWBATWorksheet)
ws.Range("A1:G10").Copy
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
wb.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub
So i assume you will be saving the second workbook for it to be named? therefore just add your path below where you want to save it, also it now retains the sheet names.
I'm not sure why you are getting a debugger error its working fine for me, try this code and see if you still get it?
Sub newworkbook()
Dim WBN As workbook, WBC As workbook, WB As workbook
Dim WS As String
Dim SHT As Worksheet
Set WBN = Workbooks.Add
For Each WB In Application.Workbooks
If WB.Name <> WBN.Name Then
For Each SHT In WB.Worksheets
SHT.Copy After:=WBN.Sheets(WBN.Worksheets.Count)
WBN.Sheets(WBN.Worksheets.Count).Name = (SHT.Name) & " "
Next SHT
End If
Next WB
Application.DisplayAlerts = False
WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
WBN.Application.DisplayAlerts = True
ActiveWorkbook.SaveAs "C:\YOURPATH\timetable_v2.xls" 'change path to whatever
End Sub
You can try as follow:
Sub CopyPaste()
Dim aSheet As Worksheet
Dim workbook As workbook
Dim index As Integer
Set workbook = Workbooks.Add(xlWBATWorksheet)
For Each aSheet In Worksheets
aSheet.Range("A1:G10").Copy
workbook.Sheets(index).Range("A1").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
index = index + 1
Application.CutCopyMode = False
Next aSheet
End Sub
Just had a quick look for you, this seems to do the job:
credit: get digital help
Dim WBN As Workbook, WBC As Workbook, WB As Workbook
Dim WS As String
Dim SHT As Worksheet
Set WBN = Workbooks.Add
For Each WB In Application.Workbooks
If WB.Name <> WBN.Name Then
For Each SHT In WB.Worksheets
SHT.Copy After:=WBN.Sheets(WBN.Worksheets.Count)
WBN.Sheets(WBN.Worksheets.Count).Name = Left(WB.Name, 30 - Len(SHT.Name)) & "-" & SHT.Name
Next SHT
End If
Next WB
Application.DisplayAlerts = False
WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
WBN.Application.DisplayAlerts = True
I just deleted WBN.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
And it works fine
The new workbook is saved as an .xlsx file, but of course I Need it as an .xlsm file....when I just added it into the path, it doesnt work
ActiveWorkbook.SaveAs "U:\Excel\timetable_v2.xlsm"
I am trying to do a copy and paste of data in between workbooks and worksheets. I have the following codes but it seems to be taking up much time. I was wondering if there is any simpler way in copying?
Sub Test1()
Dim wb As Workbook, x As String, y As String, wb1 As Workbook
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then x = wb.Name
Next wb
Workbooks(x).Activate
Sheets("Sheet1").Range("A:E").Copy
ActiveWindow.WindowState = xlMinimized
Sheets("Sheet1").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll
Sheets("Sheet1").Range("A1").Select
Workbooks(x).Activate
ActiveWindow.WindowState = xlNormal
Sheets("Sheet1").Range("F:F").Copy
ActiveWindow.WindowState = xlMinimized
Sheets("Sheet1").Range("G:G").Select
Selection.PasteSpecial Paste:=xlPasteAll
Workbooks(x).Activate
ActiveWindow.WindowState = xlNormal
End Sub
Some headsup:- Use
Sub Test1()
Application.Screenupdating = False
'yourcode
Application.Screenupdating = True
End Sub
in your code to execute it faster
for copy paste a short verion that can be used is
Sheets("Sheet1").Range("F:F").Copy Sheets("Sheet1").Range("G:G")
Instead of activating certain books try pasting directly to the destination as mentioned in the above code.
you can remove "ActiveWindow.WindowState = xlMinimized"
EDIT:- as per added comments
dim wb1 as workbook
dim wb2 as workbook
set wb1 = ("Filename.xlsx")
set wb2 = ("filename.xlsx")
wb1.sheetname.range("A1").copy wb2.sheetname.range("A1")
you can further decalre your sheetname as well
dim ws as worksheet
set ws = worksheets("Sheetname")
Edit as per second comment (add variable to newly opened workbook)
Dim path as variant
dim wsb as workbook
path = \\C:your path ' not the sheet name
Set wsb = Workbooks.Open(filename:=myfolder & "\" & "filename".xlsm")
'your codes
I got some idea from JMAX and found a way which is as follows:
Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set targetworkbook
Set wb2 = ActiveWorkbook
'For instance, copy data from a range in the first workbook to another range in the other workbook
wb2.Worksheets("Sheet1").Range("A:B").Copy
wb.Worksheets("Sheet1").Activate
wb.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteAll
End Sub