I have a sheet Rolling Plan in copy.xls worksheet.I want to copy it to Book1.xls worksheet in Sheet NO1 in Range A1:H6
The macro in Book.xls
Sub CopytoPS()
Dim sfil As String
Dim owbk As Workbook
Dim sPath As String
sPath = "C:\Users\Nirmala\Desktop\website" 'Change the file path for your purposes
sfil = Dir(sPath & "copy.xls")
Range("B6:H6").Copy
Set owbk = Workbooks.Open(sPath & sfil)
owbk.Sheets("RollinPlan").Range("B6:H6").End(xlUp).Offset(1, 0).
PasteSpecial xlPasteValues
owbk.Close True 'Save opened workbook and close
sfil = Dir
End Sub
This does the following:
1) Open copy.xls and copy data in range B6:H6
2) Pastes the data into workbook Book1 in range A1:H6 on sheet NO1
Sub CopyData()
Dim filePath As String, wb As Workbook
filePath = "C:\Users\Nirmala\Desktop\website" 'Change the file path for your purposes
Set wb = Workbooks.Open(Filename:=filePath & "\" & "copy.xls")
wb.Worksheets("Rolling Plan").Range("B6:H6").Copy Destination:=ThisWorkbook.Worksheets("NO1").Range("A1:H6")
wb.Close
End Sub
Note that I am not quite sure why the data range you are copying to (i.e. A1:H6) is much larger than the actual copied range (i.e. B6:H6).
Related
I have multiple workbooks in a single folder. All the workbooks share the same format and I wish to copy from the same range on the first worksheet in all workbooks and add this to a single worksheet of a newly created workbook.
The code so far:
Sub OpenAllCompletedFilesDirectory()
Dim Folder As String, FileName As String
Folder = "pathway..."
FileName = Dir(Folder & "\*.xlsx")
Do
Dim currentWB As Workbook
Set currentWB = Workbooks.Open(Folder & "\" & FileName)
CopyDataToTotalsWorkbook currentWB
FileName = Dir
Loop Until FileName = ""
End Sub
Sub AddWorkbook()
Dim TotalsWorkbook As Workbook
Set TotalsWorkbook = Workbooks.Add
outWorkbook.Sheets("Sheet1").Name = "Totals"
outWorkbook.SaveAs FileName:="pathway..."
End Sub
Sub CopyDataToTotalsWorkbook(argWB As Workbook)
Dim wsDest As Worksheet
Dim lDestLastRow As Long
Dim TotalsBook As Workbook
Set TotalsBook = Workbooks.Open("pathway...")
Set wsDest = TotalsBook.Worksheets("Totals")
Application.DisplayAlerts = False
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
argWB.Worksheets("Weekly Totals").Range("A2:M6").Copy
wsDest.Range("A" & lDestLastRow).PasteSpecial
Application.DisplayAlerts = True
TotalsBook.Save
End Sub
This works - to a point. It does copy the correct ranges across and place the results one below another on the "Totals" worksheet of the "Totals" workbook, but it raises a 'Subscript out of range' error on:
argWB.Worksheets("Weekly Totals").Range("A2:M6").Copy
after data from the last workbook has been pasted.
How can I tidy this code so that it works without error?
I imagine there is scope to improve the code too.
I'd maybe do something like this.
Note you can just open the summary workbook once before looping over the files.
Sub SummarizeFiles()
'Use `Const` for fixed values
Const FPATH As String = "C:\Test\" 'for example
Const TOT_WB As String = "Totals.xlsx"
Const TOT_WS As String = "Totals"
Dim FileName As String, wbTot As Workbook, wsDest As Worksheet
'does the "totals" workbook exist?
'if not then create it, else open it
If Dir(FPATH & TOT_WB) = "" Then
Set wbTot = Workbooks.Add
wbTot.Sheets(1).Name = TOT_WS
wbTot.SaveAs FPATH & TOT_WB
Else
Set wbTot = Workbooks.Open(FPATH & TOT_WB)
End If
Set wsDest = wbTot.Worksheets(TOT_WS)
FileName = Dir(FPATH & "*.xlsx")
Do While Len(FileName) > 0
If FileName <> TOT_WB Then 'don't try to re-open the totals wb
With Workbooks.Open(FPATH & FileName)
.Worksheets("Weekly Totals").Range("A2:M6").Copy _
wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1)
.Close False 'no changes
End With
End If
wbTot.Save
FileName = Dir 'next file
Loop
End Sub
I have an application in Excel with macro. It imports any number of sheets to the workbook and performs certain calculation in each file except to the one file (user interface).
I want to make a hard copy of the sheets except the user interface sheet. Basically it has to create a new workbook and copy the contents of my application to the new workbook and save it without macro. I tried different approaches, however most save the application as is.
Sub Save_files()
Dim Current As Worksheet
Dim newBook As Workbook
Dim newPath As String
newPath = ThisWorkbook.Path & "\" & "RM_" & myDate & ".xlsx"
Set newBook = Workbooks.Add
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
'If Current.Name <> "Start" Or Current.Name <> "Exception" Then
Current.Copy Before:=newBook.Sheets(1)
newBook.SaveAs fileName:=newPath
'End If
Next
End Sub
I was using this code that can save a single sheet and then I added a for loop to iterate over all sheets and save them but it failed many times.
Try the next way, please:
Sub Save_files()
Dim Current As Worksheet, CopyWB As Workbook
Dim newBook As Workbook, MyDate As String
Dim newPath As String
MyDate = Format(Date, "dd_mm_YY") 'the format you need
Set CopyWB = ActiveWorkbook 'please, use here the workbook to copy from
newPath = ThisWorkbook.Path & "\" & "RM_" & MyDate & ".xlsx"
Set newBook = Workbooks.Add
' Loop through all of the worksheets in the active workbook.
For Each Current In CopyWB.Worksheets
' If Current.Name <> "Start" Or Current.Name <> "Exception" Then
Current.Copy Before:=newBook.Sheets(1)
' End If
Next
newBook.SaveAs fileName:=newPath
End Sub
I am using the code below to copy a worksheet from a source workbook to several hundred destination workbooks. The source worksheet contains references (in formula) to other worksheets in the source workbook; I would like to keep these references between sheets, but in the destination workbook. Can this code be modified to do this?
Option Explicit
Public Sub CopySheetToAllWorkbooksInFolder()
Dim sourceSheet As Worksheet
Dim folder As String, filename As String
Dim destinationWorkbook As Workbook
'Worksheet in active workbook to be copied as a new sheet to the destination workbook
Set sourceSheet = ActiveWorkbook.Worksheets("Edit")
'Folder containing the destination workbooks
folder = "M:\Employee Information\Peter Young\Msc Project\1 - 181028 - Office First Floor\MacroCopy\"
filename = Dir(folder & "*.xlsx", vbNormal)
While Len(filename) <> 0
Debug.Print folder & filename
Set destinationWorkbook = Workbooks.Open(folder & filename)
sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
destinationWorkbook.Close True
filename = Dir() ' Get next matching file
Wend
End Sub
Try something like this:
Public Sub CopySheetToAllWorkbooksInFolder()
Dim sourceWorkbook As Workbook
Dim sourceSheet As Worksheet
Dim destinationWorkbook As Workbook
Dim folder As String, filename As String
'Worksheet in active workbook to be copied as a new sheet to the destination workbook
Set sourceWorkbook = ActiveWorkbook
Set sourceSheet = sourceWorkbook.Worksheets("Edit")
'Folder containing the destination workbooks
folder = "M:\Employee Information\Peter Young\Msc Project\1 - 181028 - Office First Floor\MacroCopy\"
filename = Dir(folder & "*.xlsx", vbNormal)
While Len(filename) <> 0
Debug.Print folder & filename
Set destinationWorkbook = Workbooks.Open(folder & filename)
sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
destinationWorkbook.ChangeLink Name:=sourceWorkbook.Name, NewName:=destinationWorkbook.Name, Type:=xlExcelLinks
destinationWorkbook.Close True
filename = Dir() ' Get next matching file
Wend
End Sub
I got this by going to Data>Edit Links with the destination workbook active and the Macro Recorder turned on, choosing "Change Source" and then browsing to the destination workbook.
I have a workbook that gets created every week that has a variable name structure. The name structure is as follows : Week of Year & Invoice & date. So a sample file might be called 1_Invoice_01052018.xlsm
I have to update the report every week. I want to declare the variable workbook name as a variable in VBA. I have another workbook that contains the output of the report that is created via VBA. In this other workbook I want to be able to call the Invoice spreadsheet but since it has a variable name, I am having issues finding it. So I put together the VBA below.
Sub Test()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = "*Invoice*" & ".xlsm"
Set ws = Sheets("Sheet1")
wb.Activate
ws.Select
End Sub
However, this results in a "Type mismatch" error.
I also tried the following:
Sub Test2()
Windows("*Invoice*" & ".xlsm").Activate
End Sub
This also resulted in an error.
Any ideas on how to set a variable workbook name as a variable in VBA? I would only have one of these workbooks open at a time, so I wouldn't run into any issues
You have to set the workbook correctly:
Sub Test()
Dim wb As Workbook
Dim ws As Worksheet
Dim FilePath As String
FilePath = "C:\" & AnotherVariable & ".xlsx"
Set wb = Workbooks(FilePath)
Set ws = Sheets("Sheet1")
wb.Activate
ws.Select
End Sub
To create a new workbook you'd use Workbooks.Add. To open an existing one you'd use Workbooks.Open and then reference the worksheet within that workbook.
To change the name of the file you'd save it with a new name using the SaveAs method.
Sub Test()
Dim wb As Workbook
Dim ws As Worksheet
Dim FileName As String
Set wb = Workbooks.Add 'Creates a new workbook with default name.
'Set wb = Workbooks.Open("<path to folder>\" & FileName & ".xlsm") 'Open an existing file.
Set ws = wb.Worksheets("Sheet1")
wb.SaveAs "<path to folder>\" & FileName & ".xlsm" 'Save and rename here.
With ws
.Range("A1") = "Adding some text to this cell"
End With
End Sub
As a further example, the code below will create two workbooks before copying the sheet from the first workbook to the end of the second workbook.
Sub Test1()
Dim wb As Workbook, wb1 As Workbook
Dim ws As Worksheet
'Create first workbook so it contains only 1 sheet (xlWBATWorksheet)
', reference Sheet1 and add some data to it.
Set wb = Workbooks.Add(xlWBATWorksheet)
Set ws = wb.Worksheets("Sheet1")
ws.Range("A1") = "This cell populated in first workbook."
'Create second workbook with default number of sheets
'and copy Sheet1 from first book to the end of this one.
Set wb1 = Workbooks.Add
ws.Copy After:=wb1.Sheets(wb1.Sheets.Count)
End Sub
Edit again:
To figure out the workbook name based on WeekNumber_Invoice_Date you could use:
Sub Test2()
Dim wb As Workbook
Dim sPath As String
Dim dDate As Date
dDate = Date 'Todays date
sPath = "C:\MyFolder\"
sPath = sPath & _
WorksheetFunction.WeekNum(dDate, 2) & "_Invoice_" & Format(dDate, "ddmmyyyy") & ".xlsm"
'Open if already exists.
'Set wb = Workbooks.Open(sPath)
'Create and SaveAs new name.
Set wb = Workbooks.Add
wb.SaveAs sPath
End Sub
This would give a file path of C:\MyFolder\43_Invoice_22102018.xlsm based on todays date of 22nd October '18.
Note: The WEEKNUM function considers the week containing January 1 to be the first week of the year.
I was able to get what I need from the following link:
excel-vba-extract-text-between-2-characters
I reviewed the link above and put together the VBA below.
Sub test2()
Dim str As String
Dim openPos As Integer
Dim closePos As Integer
Dim midBit As String
str = Range("b1").Value
openPos = InStr(str, "[")
closePos = InStr(str, "]")
midBit = Mid(str, openPos + 1, closePos - openPos - 1)
'MsgBox (midBit)
Windows(midBit).Activate
End Sub
I ended up creating a dynamic file path in cell B1 that contained a concatenated file path string that contained look ups to pull in the Week of Year and Date based on the Current Date. Since this path is dynamic it will always point to the right path given that I open the Invoice on the correct week. I pulling the file name from the path and opening based on the file name which is dynamic.
Sub values_dump()
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim ws As Worksheet
Dim path As String
Dim fname As String
Application.ScreenUpdating = False
path = ThisWorkbook.path & "\_bck\"
fname = "values_" & Format(Now, "dd_mmm_yy_hh_mm_ss") & ".xlsm"
Set sourceWB = ThisWorkbook
Set destWB = Workbooks.Add
destWB.SaveAs path & fname
For Each ws In sourceWB.Worksheets
Workbooks(sourceWB).Sheets(ws).Copy after:=Workbooks(destWB).Sheets(1)
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I am getting an error on this line destWB.SaveAs path & fname - it says that I cannot use the ".xlsm" extension ?
In addition I would like to copy the sheets to the new workbook but only retain the values and original formatting.
My code, erroneously copies all the formulae. I do not want to destruct in any way the original workbook.
You are arbitrarily tacking on a Macro-Enabled Workbook file extension (e.g. xlsm) but using Workbook.SaveAs method with the default FileFormat paramter (found in Excel Options ► Save ► Save files in this format:. In fact, it would be better to leave off the .xlsm altogether and specify the desired file format. Excel will add .xlsm if you pick the correct format. See xlFileFormat enumeration for a full list of available SaveAs file types.
If you want to revert the formulas to their values, simply make a copy of the worksheet then use .Cells = .Cells.Value.
Sub values_dump()
Dim sourceWB As Workbook
Dim destWB As Workbook
Dim ws As Worksheet
Dim path As String
Dim fname As String
Dim c As long
Application.ScreenUpdating = False
path = ThisWorkbook.path & "\_bck\"
fname = "values_" & Format(Now, "dd_mmm_yy_hh_mm_ss") & ".xlsm"
Set sourceWB = ThisWorkbook
Set destWB = Workbooks.Add
destWB.SaveAs Filename:=path & fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled 'Open XML Workbook Macro Enabled (52)
For Each ws In sourceWB.Worksheets
if ws.autofiltermode then ws.autofiltermode = false
ws.Copy after:=destWB.Sheets(1)
With destWB.Sheets(2).usedrange
for c = 1 to .columns.count
.columns(c).Cells = .columns(c).Cells.Value
next c
End With
destWB.save
Next ws
Application.ScreenUpdating = True
End Sub
When you Set a workbook-type var to a Workbook Object, you can use the var directly. You seemed to be using it like it was the Workbook.Name property. The same goes for the Worksheet Object and the Worksheet .Name property.