Find date, create new workbook, copy lines with same dates in column H
Place this in the ThisWorkbook module of the workbook being saved.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim newWb As Workbook, origWb As Workbook
Dim cl As Range, sRange As Range
Dim BotRow As Long, aRow As Long
Dim rDate As Date
If MsgBox("Do you want to transfer?", vbQuestion + vbYesNo) =
vbYes Then
BotRow =
ThisWorkbook.ActiveSheet.Range("H65536").End(xlUp) .Row
Set newWb = Workbooks.Add(Template:="C:\TemplateFile.xlt")
Set sRange = ThisWorkbook.ActiveSheet.Range("H2:H" & BotRow)
rDate = WorksheetFunction.Max(sRange)
For Each cl In sRange
If cl.Value = rDate Then
r = cl.Row
ThisWorkbook.ActiveSheet.Range("A" & r & ",G" & r &
",H" & r).Copy
newWb.ActiveSheet.Range("A65536").End(xlUp).Offset (1,
0).PasteSpecial xlPasteAll
Application.CutCopyMode = False
End If
Next
End If
End Sub
Please note that this is not tested thoroughly and contains no error
handling. This could be streamline da little further, but this gets
the job done. You may need to make a few tweaks here and there. And
you'll need to plug in the location of your template file.
HTH
-Jeff-
littleme wrote:
Have a tricky one i think... at least for me.... I enjoy the challenge
of excel and vba but never know how to start things off...
Here is what I would like in a perfect world:
A macro that is triggered when workbook "LIST" is saved.
First message box. Do you want to transfer? If no, just save. If yes
THEN.....
Open new workbook based on template TRANSFER.
Search column H in LIST for rows with most recent date.
Extract information froms those rows, but only info found i columns A,
G and H and place in new workbook on first available rows into
columns A, B and C.
Does this make sense? Is it really hard? Can anyone help me?
Would really appreciate any scrap of help...
|