I am new to macros.I want to write a macro to copy specific data in columns in MPP to another using excel.
I have found a code that will copy data from one excel to another.please help
Option Explicit
Sub CopytoPS()
Dim sfil As String
Dim owbk As Workbook
Dim sPath As String
sPath = "C:\Users\HYMC\Excel\Test\" 'Change the file path for your purposes
sfil = Dir(sPath & "Management Report PS.xls")
Range("A2:I22").Copy
Set owbk = Workbooks.Open(sPath & sfil)
owbk.Sheets("Sales Data").Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
owbk.Close True 'Save opened workbook and close
sfil = Dir
End Sub
I want to copy certain coloums in MPP to a set of cloumns in Excel.I also want user to just give the destination file path,source file ,source cells to be copied and destination cells
To work with MPP file in Excel, Open the VBA Editor and click References on the Tools menu. In the Available References list, click to select the Microsoft Project xx.xx Object Library check box. If the Microsoft Project 9.0 Object Library is not listed, click Browse to locate the MsprjXX.olb file, which is in the folder where you have Microsoft Project installed. The default location is C:\Program Files\Microsoft Office\Office. Click OK to close the References dialog box. Then Use this code.
Since you have not mentioned what you want to copy and where exactly, i will give you a very basic code which you can then work on.
'~~> Code to open MPP file in Excel
Sub Sample()
Dim appProj As MSProject.Application
Dim aProg As MSProject.Project
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
'~~> This is the Sheet Where you want the data to be copied
Set ws = wb.Sheets("Sheet1")
Set appProj = CreateObject("Msproject.Application")
'~~> This is a MS Project File. Change path as applicable.
appProj.FileOpen "C:\MS Project.mpp"
Set aProg = appProj.ActiveProject
appProj.Visible = True
'~~> Now you have the MPP file opened, rest of the code goes here
End Sub
prerna: Can u also provide me the tutorial to learn macros to be used in excel.It would be very helpful
You can visit this link which is a good start. But ultimately, it all depends on how much you practice :)
Topic: Record and use Excel macros
Link: http://office.microsoft.com/en-us/excel-help/record-and-use-excel-macros-HA001054837.aspx
More On Macros:
http://www.excel-vba.com/
http://www.excel-vba-easy.com/
http://www.mrexcel.com/articles.shtml
Related
I have two workbooks, a shared "xlsx" file A which stores data and no-sharing "xlsm" file B which contains my macros. I would like maintain periodic tracking of changes in file A and password-protect this change history. I know there is a "Track Changes" feature in file A and it could create a separate sheet containing the change history. However, this sheet is within workbook A, which is being shared. Is there a way to write a macro in B to periodically extract this change history from A, put it into a "xlsx" file C with password?
The point here is I would like to prevent the change history to be compromised. Only I have access to it. Note that I can not make file A "macro enabled" and write macro in it.
Thank.
When you open the Shared WB, update the change info, then copy the History sheet
Sub Demo()
Dim wbShared As Workbook
Dim wbHistory As Workbook
Set wbHistory = Application.Workbooks.Open( _
Filename:="\\Path\To\Your\History\FileC.xlsx", _
Password:="Password")
Set wbShared = Application.Workbooks.Open( _
FileName:="\\Path\To\Your\Shared\FileA.xlsx")
' Generate History Sheet (maybe change xlAllChanges to suit needs)
With wbShared
.HighlightChangesOptions _
When:=xlAllChanges, _
Who:="Everyone"
.ListChangesOnNewSheet = True
End With
' Copy out History to FileC
wbShared.Worksheets("History").Copy After:=wbHistory.Sheets(wbHistory.Sheets.Count)
' Clean Up
wbShared.Close False
wbHistory.Close True
End Sub
Using your private workbook, you can use macros to open the shared workbook and copy the sheet into the private workbook again.
EDIT: Sorry, I missed the part about saving it into a file C.
Here is to get you started:
Sub wbCopy()
Dim sharedWb, myWb As Workbook
Dim sharedWs As Worksheet
Set myWb = New Workbook
Workbooks.Open Filename:="192.168.0.10\sharedWorkbook.xls", ReadOnly:=True
Set sharedWb = "sharedWorkbook.xls"
Set sharedWs = sharedWb.Worksheets(2)
sharedWs.Copy myWb.Worksheets(Sheets.Count)
Workbooks("sharedWorkbook.xls").Close
myWb.SaveAs Filename:="File C.xls"
End Sub
I currently use a lot of spreadsheets to do my job that visualize incoming data that is always changing.
The main issue that I have run into is the file that I export every day has a naming system that is based on some algorithm that has relation to the date and time that the information was pulled, but is somewhat generated at random. This means that the workbook always has a different name and because of the copious amounts of reports that we pull, I prefer to be able to extract the information, transfer it to the main sheet, and delete the exported file. The macro that I came up with through recording my actions works fine if ALL other Microsoft applications are closed (if Word, Outlook, or another Excel file are open, the macro crashes with a define error).
Can anyone suggest a solution for being able to execute a code to format a file when the name is constantly changing? I can paste an example of what I have, but it's a long code due to the formatting. The basics are:
Sub RECORDTHIS()
Dim sht As Object
Set sht = ActiveWorkbook.ActiveSheet
sht.Select
sht.Name = "MYDATA"
'Lots of formatting commands
End Sub
Why don't you "Open" the workbook you want to process. Something like this
Sub DemoOpen()
Dim FName As Variant
Dim wb As Workbook
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls")
If FName <> False Then
Set wb = Workbooks.Open(FName)
Dim sht As Worksheet
Set sht = wb.ActiveSheet
sht.Name = "MYDATA"
'Lots of formatting commands
End If
End Sub
I have a workbook containing one worksheet ("DB Output" or Sheet 34) which I would like to copy to several (around 45) files in within the same folder.
None of the target files have an existing sheet named "DB Output" - the objective is to find a way to insert a copy of this sheet, forumlas and all, into each one.
The range of cells on that sheet that needs to be copied to a sheet of the same name in each book is A1:PE5
The sheet contains references to cells in the book it is currently in, however as the files which I am seeking to copy the worksheet to all share the same template, I want the references to be to the local file, not the original one.
I've tried looking at RDBMerge, however it seems that is for merging sheets, and while I do want to do that, it will not help me do it multiple times quickly.
Likewise I have looked on SO for similar situations, this is the closest, however my attempts to adapt that code have failed as I only have a single workskeet. Never the less, as it is always useful to inlcude what you have already tried, here is my existing attempt:
Option Explicit
Public Sub splitsheets()
Dim srcwb As Workbook, trgwb As Workbook
Dim ws As Worksheet, t1ws As Worksheet
Dim rng1 As Range
Dim trgnm As String
Dim fpath As String
Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
fpath = "C:/file/path/"
Set srcwb = ThisWorkbook
For Each ws In srcwb.Worksheets
trgnm = ws.Name
'--> Change A1:B3 to the range to be copied to inside page
Set rng1 = srcwb.Sheets(trgnm).Range("A1:PE5")
Set trgwb = Workbooks.Open(fpath & trgnm & ".xlsm")
With trgwb
Set t1ws = .Sheets("DB Output")
End With
'--> Change A1:B3 to the range where you want to paste
rng1.Copy t1ws.Range("A1:PE5")
trgwb.Close True
Next
Application.ScreenUpdating = True
End Sub
However this starts with the first sheet in the workbook that contains DB Output (the sheet to be copied) and gives an error that "NameOfSheet1.xlsm" does not exist in that directory (which it does not).
Any help is much appreciated.
This should copy from the active workbook to all files in a directory. If you need help modifying it to fit your specific use let me know!
Edit: fixed code to only copy A1:PE5 and save each workbook.
Sub Example()
Dim path As String
Dim file As String
Dim wkbk As Workbook
path = "C:\Test\"
file = Dir(path)
Application.DisplayAlerts = False
Do While Not file = ""
Workbooks.Open (path & file)
Set wkbk = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "DB Output"
ThisWorkbook.Sheets("DB Output").Range("A1:PE5").Copy Destination:=wkbk.Sheets("DB Output").Range("A1")
wkbk.Save
wkbk.Close
file = Dir
Loop
Application.DisplayAlerts = True
End Sub
Please note that I did not add error handling so this could break if the active workbook is included in the directory you are trying to copy or if a sheet with the same name already exists in the workbook. If this is an issue let me know and I will add error handling.
A non-IT related class has been assigned a group project where the work they do will be stored is a single .xlsx file. The members decided the best way to collaboratively edit said file would be to split it into its constituent sheets, upload each *.xlsx sheet to an SVN repository, and use locks and a .txt file to organize sheet/member responsibility.
The group has accomplished the splitting of said files with a VB script (courtesy of this wonderful site) which was as follows:
Sub SaveSheets()
Dim strPath As String
Dim ws As Worksheet
Application.ScreenUpdating = False
strPath = ActiveWorkbook.Path & "\"
For Each ws In ThisWorkbook.Sheets
ws.Copy
'Use this line if you want to break any links:
BreakLinks Workbooks(Workbooks.Count)
Workbooks(Workbooks.Count).Close True, strPath & ws.Name & ".xlsx"
Next
Application.ScreenUpdating = True
End Sub
Sub BreakLinks(wb As Workbook)
Dim lnk As Variant
For Each lnk In wb.LinkSources(xlExcelLinks)
wb.Breaklink lnk, xlLinkTypeExcelLinks
Next
End Sub
Therewith the group now has a repository where each member is currently in the process of editing their respective files. The question then is, how can we automate the re-unification of these files into one .xlsx file with the preservation of the original links.
EDIT 4/2: started bounty // I'm aware that the links were "broken" by the above script but am not exactly sure what this means though I suspect it would make re-assembly with the preservation of original links more difficult. It should be noted that the original file which had the links is still available and might could be used to assist with this problem.
EDIT 4/2: Excel version is 2010--original links do not exist in current files.
EDIT 4/3: Original links are not in the current files, but it is desired that with the re-unification the original links (from original unedited file, pre-splitting) be re-created/preserved.
If you have SharePoint, you can all update the same Excel (2003 or 2010) book.
http://office.microsoft.com/en-us/excel-help/about-shared-workbooks-HP005262294.aspx
The links then don't really apply in the solution, as you said the original doesn't have any links and so reassembly with links isn't required.
The script provided even has a comment embedded saying "Use this line if you want to break any links:". So if you comment the line below out (prepend the line with a ') it will preserve the links in the child workbooks.
Using the answer to a previous question on copying sheets to another workbook reassembly can be accomplished with the following VBA:
Sub CombineSheets()
Dim strPath As String
Dim ws As Worksheet
Dim targetWorkbook As Workbook
Set targetWorkbook = ActiveWorkbook
Application.ScreenUpdating = False
'Adjust path location of split files
strPath = "C:\code\xls-split"
Dim str As String
'This can be adjusted to suit a filename pattern.
str = Dir(strPath & "\*.xl*")
Do Until str = ""
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(strPath & "\" & str, UpdateLinks:=0)
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
Next Sheet
wbResults.Close SaveChanges:=False
str = Dir()
Loop
Application.ScreenUpdating = True
End Sub
This will append the other workbooks to the currently opened workbook.
Sourced Replacing FileSearch function for code to find xls files in a directory.
We probably need more detail in order to help you, but you may be able to accomplish what you need as follows (maybe this can kick-start a solution):
Loop through the sheets in the workbook
For each sheet
Open the appropriate xlsx file
Identify non-formula cells
For each of those cells
Copy to the identical location in the main workbook
Close the xlsx file
Below is an example (based on your SaveSheets code). If you try this, be sure to backup everything first. We obviously don’t know how the spreadsheets are laid out and how they are used. It would really suck if it got all screwed up. Also, there are some assumptions:
The layout and used range in the xlsx files are the exact same layout and used range as it appears in the original workbook.
The links you are referring to are formulas (either to another sheet or another workbook).
If these assumptions are wrong, you will need to modify as appropriate (identifying specific ranges to copy and/or adding more robust logic to the routine).
Note that the actual code to do this is very short. I added comments and basic error handling which significantly increased the amount of code.
This code would be added to the original workbook.
Sub RetrieveSheets()
Dim strPath As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim wbk As Workbook
Dim rng As Range
Application.ScreenUpdating = False
strPath = ActiveWorkbook.Path & "\"
For Each ws In ThisWorkbook.Sheets
'Open the xlsx file (read only)
Set wbk = Nothing
On Error Resume Next
Set wbk = Workbooks.Open(strPath & ws.Name & ".xlsx", ReadOnly:=True)
On Error GoTo 0
'Continue if xlsx file was successfully opened
If Not wbk Is Nothing Then
Set ws2 = Nothing
On Error Resume Next
Set ws2 = wbk.Worksheets(ws.Name)
On Error GoTo 0
'Continue if appropriate sheet was found
If Not ws2 Is Nothing Then
'Identify cells to copy over (cells that are constants)
For Each rng In ws2.Cells.SpecialCells(xlCellTypeConstants)
'set the cell value equal to the identical cell location in the xlsx file
If (Left(ws.Range(rng.Address).Formula, 1)) <> "=" Then
ws.Range(rng.Address) = rng
End If
Next
Set ws2 = Nothing
End If
'Close the xlsx file
wbk.Close False
End If
Next
Set wbk = Nothing
Application.ScreenUpdating = True
End Sub
This is a rough outline of how I accomplished this:
Use Office2013 and not office 2010
create tmp/ directory with original .xlsx assignment file.
create source/ directory in tmp/
use split sheets module (listed on this page), but comment out the line that break links.
place all of the resulting .xlsx files into source/ (you can delete the original .xlsx file)
remote the first sheet from the sources/ folder, and place it ../
Open this first sheet, and import/use the 'combinesheets' module listed on this page.
Save the sheet, reopen it and you'll be prompted to update links. Do so, and select "change source" and select the first sheet Re in step 6.
links will automatically update; done.
Notes: you'll have to save a file as macro enabled, ...
Take a look at this MSDN Article on Merging Data from multiple workbook (.xls/.xlsx) files
http://msdn.microsoft.com/en-us/library/office/gg549168%28v=office.14%29.aspx
I don't know much about VBA but I think this is what you are looking for.
Also note it does get rid of the need for a text file to manage the files
I have an excel macro saved in a blank workbook and multiple data workbooks.
I currently open the macro file and each data file individually, running the macro on each one with a keyboard shortcut.
Is there a way to run the macro on all the data workbooks without opening them, either with
a batch file,
VBA/VBScript,
powershell,
or something similar?
One way to do this is to add your macro's to the file PERSONAL.XLSB. This file will be loaded in the background every time you start Excel. Initially the PERSONAL.XLSB file will NOT be there.
To automatically create this file, just start recording a "dummy" macro (with the record button on the left-bottom of a spreadsheet) and select "Personal Macro Workbook" to store it in. After recording your macro, you can open the VBA editor with [Alt]+[F10] and you will see the PERSONAL.XLSB file with the "dummy" macro.
I use this file to store loads of general macro's which are always available. I have added these macro's to my own menu ribbon.
One disadvantage of this common macro file is that if you launch more than one instance of Excel, you will get an error message that the PERSONAL.XLSB file is already in use by Excel instance Nr. 1. This is no problem as long as you do not add new macro's at this moment.
Two potential solutions below,
vbscript which can be run directly as a vbs file
A vba solution to be run from within Excel (as per Tim Williams suggestion)
vbscript solution
Dim objFSO
Dim objFolder
Dim objFil
Dim objXl
Dim objWb
Dim objExcel
Set objExcel = CreateObject("Excel.Application")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objFolder = objFSO.getfolder("c:\temp")
For Each objFil In objFolder.Files
If InStr(objFil.Type, "Excel") > 0 Then
Set Wb = objExcel.Workbooks.Open(objFil.Path)
wscript.echo Wb.name
Wb.Close False
End If
Next
vba solution
Sub OpenFilesVBA()
Dim Wb As Workbook
Dim strFolder As String
Dim strFil As String
strFolder = "c:\Temp"
strFil = Dir(strFolder & "\*.xls*")
Do While strFil <> vbNullString
Set Wb = Workbooks.Open(strFolder & "\" & strFil)
Wb.Close False
strFil = Dir
Loop
End Sub
I sort of stumbled across your post just now, maybe very late, but for all future searches.
It is possible to launch your Macro by creating a .vbs file.
To do this, open notepad and add the following:
objExcel = CreateObject("Excel.Application")
objExcel.Application.Run <insert macro workbook file path, module and macro name here>
objExcel.DisplayAlerts = False
objExcel.Application.Save
objExcel.Application.Quit
Set objExcel = Nothing
save the file as follows ("your filename".vbs)
By double clicking (opening) the saved .vbs file, it will launch your macro without you having to open your excel file at all.
Hope this helps.
You could keep the macro in your personal.xls, or a masterfile, and loop through the workbooks with vba, and activate them before running your macro. As far as I know, you still have to open them with vba though.
You could use something like this:
sub LoopFiles
Dim sFiles(1 to 10) as string 'You could also read this from a range in a masterfile
sFiles(1) = "Filename1.xls"
.
.
sFiles(10) = "Filename10.xls"
Dim wb as Workbook
Dim iCount as integer
iCount = ubound(sFiles)
Dim iCount2 as integer
For iCount2 = 1 to iCount
Workbooks(sFiles(iCount2)).open
Workbooks(sFiles(iCount2)).activate
Call YourMacro
Workbooks(sFiles(iCount2)).close
next iCount2
end sub
Other way,
Sub LoopAllWorkbooksOpened()
Dim wb As Workbook
For Each wb In Application.Workbooks
Call YourMacroWithWorkbookParam(wb)
Next wb
End Sub
Sub YourMacroWithWorkbookParam(wb As Workbook)
MsgBox wb.FullName
End Sub