I have created this piece of code, and I don't understand why I get an error
Subscript out of range
It dies when I try to set WsDest.
The two lines before I need, cause the destination file is optional, but the name of the sheet Excel file and sheet is always the same.
An example of what could be in W12 = "C:\Users\DKOMGOMG\Desktop\Etellerandet"
Sub Vopy_Paste_Below_Last_Cell()
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim 1CopyLastRow As Long
Dim 1DestLastRow As Long
Dim strFolder As string, strFile As String
Set wsCopy = Activewoork.Worksheets("output")
StrFolder = ActiveSheet.Range("W12").Value
StrFile = Dir(StrFolder & "\blablalba.xlsm")
Set wsDest = Workbooks("strFile").Worksheets("Ark2")
After this I have more code of course, but this is where I get stranded.
Don't know if I did the strfolder and strfile wrong? Hope someone can help!
Related
I am working on a VSTO Excel add-in where at some point, it will open a template workbook from Resources and copy a sheet from it to the running instance of Excel. I want to avoid the short white window flash when copying from the template so I created a hidden instance of Excel.Application and call it from there. This part works but when copying, I keep getting "System.Runtime.InteropServices.COMException: 'Copy method of Worksheet class failed'"
Dim tempFileName As String = "DesignWorks1_Template"
Dim tempName As String = Path.GetTempPath() & "\" & tempFileName & ".xlsx"
Dim ResMgr = New Resources.ResourceManager("MyUtilities.Resources", System.Reflection.Assembly.GetExecutingAssembly)
Dim fstream As New FileStream(tempName, FileMode.Create, FileAccess.Write)
Dim filestreamWrite As New BinaryWriter(fstream)
filestreamWrite.Write(My.Resources.DesignWorks1, 0, My.Resources.DesignWorks1.Length)
fstream.Close()
filestreamWrite.Close()
Dim currentWorkbook As Excel.Workbook = Globals.ThisAddIn.Application.ActiveWorkbook
Dim newHiddenApp As New Excel.Application
newHiddenApp.Visible = False
Dim oTemplate As Excel.Workbook = newHiddenApp.Workbooks.Add(tempName)
oTemplate.Worksheets(compareName).Copy(currentWorkbook.Worksheets(1)) 'error here
oTemplate.Close()
My.Computer.FileSystem.DeleteFile(tempName)
ResMgr.ReleaseAllResources()
Thanks in advance.
Is it possible to specify a particular sheet from the template? I tried Sheets.Add but it seems to import all worksheets from the specified path. – Virtual Underscore
This is the major pain point in exporting each sheet in a workbook to a WorkSheet template file. When you perform the save-as Worksheet template, the subject Worksheet must be the only Worksheet in the Workbook. If more than one Worksheet exists in the Workbook, you will be exporting a Workbook template.
You can copy the following VBA code to the ThisWorkbook code file of the Workbook you want to export templates from. Make sure you modify the templateFolder = "F:\Temp\Templates" line in the code. Run it and it will export each Worksheet in the Workbook.
Sub ExportWorksheetTemplates()
Excel.Application.DisplayAlerts = False
Excel.Application.ScreenUpdating = False
Dim templateFolder As String
templateFolder = "F:\Temp\Templates" ' set this to an existing folder on you system
Dim tmpWb As Excel.Workbook
Dim old_numsheets As Integer
old_numsheets = Excel.Application.SheetsInNewWorkbook
Excel.Application.SheetsInNewWorkbook = 1
Dim ws As Excel.Worksheet
Dim newWBFirstSheet As Excel.Worksheet
Dim templatePath As String
On Error GoTo Finalize
For Each ws In ThisWorkbook.Worksheets
Set tmpWb = Excel.Application.Workbooks.Add()
Set newWBFirstSheet = tmpWb.Worksheets(1)
newWBFirstSheet.Name = "."
ws.Copy after:=newWBFirstSheet
newWBFirstSheet.Delete
templatePath = templateFolder & "\" & tmpWb.Worksheets(1).Name & ".xltx"
tmpWb.Worksheets(1).SaveAs templatePath, Excel.XlFileFormat.xlOpenXMLTemplate
tmpWb.Close
Next
Finalize:
Excel.Application.DisplayAlerts = True
Excel.Application.ScreenUpdating = True
Excel.Application.SheetsInNewWorkbook = old_numsheets
End Sub
Now you can add each of those files to your VSTO project's resources.
Then you would export the resource templates to a temporary file as you are currently doing.
When you use the Sheets.Add method and specify Type:="path to template", you will now only get the single Worksheet added to the Workbook.
When running Excel on the desktop, you cannot copy sheets between instances. Therefore I doubt that it can be done when the Excel instances are initiated with VB.
In order to copy sheets between workbooks, these need to run in the same instance.
I have a list of unique ID's in a spreadsheet and each (but not all) of the IDs has a single related spreadsheet, all stored in the same location. I need to extract a number from each xlsx. file (in the same cell in each file) and match it to the list of unique IDs. All the files have the same naming convention of 'UniqueID_Otherinformation.xlxs' All unique IDs are 6 figures.
Sub OpenFile()
Dim sPath As String
Dim sFil As String
Dim strName As String
Dim twbk As Workbook
Dim owbk As Workbook
Dim ws As Worksheet
Set twbk = ActiveWorkbook
sPath = "C:\Data Folder\"
sFil = Dir(sPath & "*.xls")
Do While sFil <> ""
strName = sPath & sFil
Set owbk = Workbooks.Open(strName)
Set ws = owbk.Sheets(1)
ws.Range("A1", Range("A" & Row.Count).End(xlUp)).Copy
twbk.Sheets(1).Range("A65536").End(xlUp)(2).PasteSpecial xlPasteValues
owbk.Close False
sFil = Dir
Loop
twbk.Save
End Sub
I made a start but got very lost very quickly.
Edit: Apologies, not clear about my needs. I'm not sure how to solve the problem. I made a start with code above but it is not very close to what I am intending so am hoping for your expertise here as I am unsure how to proceed.
Worksheets("Source").Columns("A:D").Copy Destination:=Worksheets("Target").Range("a1")
Have a look at the above. This code moves from the first sheet to the second. No need to copy+paste, and much simpler method
Apply it to your code as needed
I am trying to create worksheets depending on the number of files present in the current folder.This is my current folder:
Folder
CalculationSheet.xls
Data1.xls
Data2.xls
Data3.xls
So I'll be searching for "/*.xls" using the count.
I need to create worksheets in CalculationSheet.xls as I am new to macro. Please help me on this.
Use a code something like this:
Sub GetDataFiles()
Dim strFolder As String
Dim fso As Object
Dim fileTemp As Object
Dim ws As Worksheet
' Open library of Microsoft Scripting Runtime
Set fso = CreateObject("Scripting.FileSystemObject")
strFolder = ActiveWorkbook.Path
If (fso.FolderExists(strFolder)) Then
' Check All files in the folder
For Each fileTemp In fso.GetFolder(strFolder).Files
If fileTemp.Name Like "Data*.xls" Then
Set ws = ActiveWorkbook.Sheets.Add
ws.Name = fileTemp.Name
End If
Next
End If
End Sub
I understand how to save a worksheet as a new workbook, but how do I can specify the name dynamically?
I've tried both Save As and Save as filename but I can't figure out how to put a variable into the name successfully.
Sub sheetCopy()
Dim wbS As Workbook, wbT As Workbook
Dim wsS As Worksheet, wsT As Worksheet
Dim title As String
title = ThisWorkbook.Worksheets("IR General Info").Range("B2").Text
Set wbS = ThisWorkbook 'workbook that holds this code
Set wsS = wbS.Worksheets("Bulk Upload")
wsS.Copy
Set wbT = ActiveWorkbook 'assign reference asap
Set wsT = wbT.Worksheets("Bulk Upload")
wsT.Name = "Exported_BulkUpload" 'rename sheet
wbT.SaveAs wbS.Path & "\" & title & ".xlsx"
End Sub
So If I make title something like "boo" with quotes - this code works. But how do I make it change based on the variable title?
Have you tried assigning the title variable to Range("B2").Value instead of Range("B2").Text ?
If the files are in the same folder, you might be able to use wbT.SaveAs FileName:=title instead
Try this:
Sub sheetCopy()
Dim wbS As Workbook, wbT As Workbook
Dim wsS As Worksheet, wsT As Worksheet
Dim title As String
title = ThisWorkbook.Worksheets("IR General Info").Range("B2").Text
'<<step through the macro and once you have gone past this point do Ctl+G to get the immediate window then type ?title in it and press enter. Or just hover your mouse over title in this script - has a value been assigned to it?
'<<the following line is not required - ThisWorkbook object is sufficient:
'Set wbS = ThisWorkbook 'workbook that holds this code
Set wsS = ThisWorkbook.Worksheets("Bulk Upload")
wsS.Copy '<<I've changed below here so it is saved straight away
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & title & ".xlsx"
Set wbT = excel.workbooks(title & ".xlsx") 'assign reference
Set wsT = wbT.Worksheets("Bulk Upload")
wsT.Name = "Exported_BulkUpload" 'rename sheet
End Sub
First time poster here. I've been reading tutorials/guides all day and made a lot of strides, but am having a tough time figuring out how to write a macro that does what I want to do.
I get around 100 time sheets per week that are then copied and imported into an accounting software. The sheets are all based off of a template, are in separate workbooks, and have a worksheet titled "Pre Import Time Card" within them. I copy the values from each book's pre import worksheet into a new file and upload them to our accounting software as a batch.
I want to have a macro open each file automatically, copy the range A1:I151 on each workbook, and then paste the values into a new worksheet. Because of the import templates design, this inevitably leads to many blank rows within the specified range. I would like to delete any blank rows as a final step.
UPDATE: I HAVE COPIED THE CODE TO REFLECT WHAT I CURRENTLY HAVE.Also a list of new problems is below.
pasting to next unused row is not working
I need to figure out how to kill the old file / not have it enter the same file twice.
I would like to suppress the "Privacy warning on VBA / Active X controls" dialog that comes up at each save.
It's not currently copying correctly. I'm getting a bug at the rDest.Resize line.
Object variable or With Block Variable not set.
I had it running when using file names in an array, but decided that was unnecessary and to use a For.. Each loop.
Sub CopySourceValuesToDestination()
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sDestPath As String
Dim sSourcePath As String
Dim aFile As String
Dim shDest As Worksheet
Dim rDest As Range
Dim i As Long
Dim TSSize As Object
Dim objFso As Object 'New FileSystemObject
Dim objFolder As Object 'Folder
Dim objFile As Object 'File
Set objFso = CreateObject("Scripting.FileSystemObject")
sDestPath = "Z:\Dropbox\My Documents\TimeSheets\Processed\"
sSourcePath = "Z:\Dropbox\My Documents\TimeSheets\Copying\"
'Open the destination workbook at put the destination sheet in a variable
Set wbDest = Workbooks.Open(sDestPath & "Destination.xlsm")
Set shDest = wbDest.Sheets(1)
Set objFolder = objFso.GetFolder(sSourcePath)
For Each objFile In objFolder.Files
aFile = objFile.Name
Set objWb = Workbooks.Open(sSourcePath & aFile)
'find the next cell in col A
Set rDest = shDest.Cells(xlLastRow + 1, 1)
'write the values from source into destination
TSSize = wbSource.Sheets(4).Range("A1").End(xlDown).Row
rDest.Resize(TSSize, 9).Value = wbSource.Sheets(4).Range("A1:I" & TSSize).Value
wbSource.Close False
wbDest.SaveAs sDestPath & "Destination.xlsm"
wbDest.Close
Kill sSourcePath & wbSource
Next
End Sub
Function xlLastRow(Optional WorksheetName As String) As Long
' find the last populated row in a worksheet
If WorksheetName = vbNullString Then
WorksheetName = ActiveSheet.Name
End If
With Worksheets(1)
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
End With
End Function
Provded your datarange in the time sheet is continuous you can replace
rDest.Resize(151,9).Value = wbSource.Sheets(1).Range("A1:I151").Value
with
var for storing
dim TSsize as long
TSsize = wbSource.Sheets(1).Range("A1").end(xlDown).Row
rDest.Resize(TSsize,9).Value = wbSource.Sheets(1).Range("A1:I" & TSsize).Value
This is prevent the empty rows from getting into your sheet in the first place.
If the each time sheet is not a continuous range you can interate through the rows looking for empty rows and deleting them. Let me know if that is the case and i will update my answer.