Navigation
Recent Posts
- Macro to insert footer
- $this PHP Variable
- php5 extensions directory and mysql undefined function
- Windows Vista biggest disappointment of 2007
- Excel giving incorrect results
- SnagIt 8.2.0 workaround
- Find Matching Text in Excel
- Excel macro to copy to Custom Template
- UK Post Code GeoCoding
- Accept User Input in SQL*Plus
- Exit SQLPlus from Batch File
- Run Multiple SQLPlus Queries via DOS batch file
- CSS Browser Differences IE and Firefox
- Create csv import file from Excel
- Use Query Result as Variable in Batch File
Archive
- November-2009
- August-2008
- January-2008
- December-2007
- November-2007
- October-2007
- September-2007
- August-2007
- June-2007
- May-2007
- April-2007
- March-2007
- February-2007
- January-2007
Popular Tags
Click tag to retrieve blogsMacro to insert footer
The following macro will insert a footer giving the page numbers, file loaction and name, and the date and time on the active sheet.
Sub myfoot()
'Dim fullpath As String
'Dim sLeft As String
'Dim sRight As String
fullpath = ActiveWorkbook.FullName
Const sPAGE As String = "&P"
Const sPAGES As String = "&N"
Const sDATE As String = "&D"
Const sTIME As String = "&T"
sLeft = "Page " & sPAGE & " of " & sPAGES
sRight = sDATE & " " & sTIME
ActiveSheet.PageSetup.CenterFooter = fullpath
ActiveSheet.PageSetup.LeftFooter = sLeft
ActiveSheet.PageSetup.RightFooter = sRight
End Sub
Excel macro to copy to Custom Template
The following macro copies an Excel sheet to a custom template. All you need do is set the template path to your own or a network drive. This is really only a snippet to demonstrate the concept but is a complete macro nonetheless. I've used it within a more complex process to generate invoices from a data file, then copy each invoice to a separate file to email out as an attachment. This was a temporary solution during the lead up to a billing system change for a Telecoms client.
I've used this to get around not being able to copy headers and footers in Excel and to avoid copying common drawing objects such as a logo and text boxes. By having these set in the template I didn't need to copy them each time the process looped.
Sub copy_ActiveSheet()
Dim wb As Workbook
Dim source As Range
Dim dest As Workbook
'Enter the path to your template file
Const TemplatePath As String = "C:mark.xlt"
Set source = Nothing
On Error Resume Next
Set source = Cells.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
Application.ScreenUpdating = False
Set dest = Workbooks.Add(TemplatePath)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With
Tags:Excel |Macro |Drawing objects |headers |footers
Merge Data from Multiple Spreadsheets
I was looking for a quick way to merge the data from multiple workbooks into one worksheet in a new excel workbook.
The process of manually going through 40+ files and manually extracting the data wasn't going to be an effective use of time.
Although I used code before to do it I couldn't lay my hands on it, which hard drive, which file etc. so I had to start again but I needed a fast solution so fired up google.
One of the first links I clicked was for DigDB, an excel add-in which actually could do the job and a lot more besides but I didn't want to pay the licence. I bookmarked the site to return to later.
The solution I found was on Ron de Bruin's Excel Tips page which contains a lot of VBA code examples which you can use for free. The code there solved the problem exactly. It copies all the ranges you specify in the source workbooks and copies them into one master worksheet.
The precise code is reproduced below with some minor additional comments. To use it open an Excel workbook. Click on tools, Macro and Visual Basic Editor. In the VB editor select View and Code. Copy the code below into that page and click save. Save the file as basebook.xls on your C drive.
In the VB editor change the ranges you want to copy as required.
Dim basebook As
Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
MyPath = "C:source_data"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
rnum = 1
Do While FNames ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A2:E2")
'If the worksheets are named use mybook.Worksheet("NameOfWorksheet")
'Set the range as required
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "B")
' Change the column letter above depending on where you want the data to start on the destination sheet
' Change the column letter in in this section - Cells(rnum, "ColumnLetter")
' basebook.Worksheets(1).Cells(rnum, "F").Value = mybook.Name
' Uncomment the line above if you want to add the workbook name into a column on the destination worksheet
' Change the column letter in in this section - Cells(rnum, "ColumnLetter")
sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only the values
' With sourceRange
' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
' Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value
mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
To use it the source files need to saved into a folder named source_data on the C drive, i.e. C:/source_data
From within basebook.xls select tools and macro. Select the macro to run.
Tags:Excel |Macro |VBA |Spreadsheeets