smorales1222
New Member
- Joined
- Oct 27, 2011
- Messages
- 1
I am using the following Macro to populate information from one spreadsheet into another. i am having an issue with the date. The Purchasing spreadsheet just has an order date but the test spreadhseet has it broken out by month. Any ideas??
'*****************************************************************************
' Copies cells F, G, M, A from this spreadsheet|2011 Ordered to Budget_TEST|CapEx
' (modify filename as needed below). Expects destination spreadsheet to be
' open (change this by using the commented workbook.open method below)
'
' Determines the destination files last row to write to the end of sheet
'
' CAUTION: Starts from row 2 of the worksheet each time, behavior could
' be changed depending on desired behavior. This is currently governed
' by the hardcoded 2 in the loop, see comments in code
'*****************************************************************************
Sub CopyCAPEXData()
Dim DestWorkBook As Workbook
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
Set SourceSheet = ActiveSheet
'*Modify filename below as needed
Set DestWorkBook = Workbooks("111010_DDMG_Technology_Working_Budget_Plan_v1.0 TEST.xlsx") '*if you want to load instead: Workbooks.Open("Z:\Documents\Budget_test.xlsx")
Set DestSheet = DestWorkBook.Worksheets("CAPEX")
Dim sRow As Long '* governs source start row for data transfer
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long 'count of rows copied
Dim LastRow As Long 'last row of source sheet
sCount = 0
LastRow = ActiveSheet.Cells.Find(what:="*", after:=ActiveSheet.Cells(1, 1), searchorder:=1, searchdirection:=2).Row + 1
dRow = DestSheet.Cells.Find(what:="*", after:=DestSheet.Cells(1, 1), searchorder:=1, searchdirection:=2).Row + 1
With SourceSheet
'skip the header to avoid writing a non zero value
'modify sRow to change source row behavior
For sRow = 2 To LastRow
'copy if capex value > 0
If .Cells(sRow, "G") > 0 Then
SourceSheet.Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "D") 'Copy Description
'And (.Cells(sRow, "A") Between #09/1/11# And #10/1/11#) Then .Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "P") 'Copy Value If ((Date >= (.Cells(sRow, "A"))("09/1/11"(Order Date <"10/1/11")
'.Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "Q") 'Copy Value If ((Date >= Order Date("10/1/11"(Order Date <"11/1/11")
.Cells(sRow, "M").Copy Destination:=DestSheet.Cells(dRow, "G") 'Copy Notes
.Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A") 'Copy Date
.Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "B") 'Copy PO
dRow = dRow + 1
sCount = sCount + 1
End If
If .Cells(sRow, "G") > 0 And .Cells(sRow, "A") >= OrderDate(#10/1/2011#)(OrderDate < (#11/1/2011#)) Then
'SourceSheet.Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "D") 'Copy Description
'Then .Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "P") 'Copy Value If ((Date >= (.Cells(sRow, "A"))("09/1/11"(Order Date <"10/1/11")
'.Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "Q") 'Copy Value If ((Date >= Order Date("10/1/11"(Order Date <"11/1/11")
'.Cells(sRow, "M").Copy Destination:=DestSheet.Cells(dRow, "G") 'Copy Notes
'.Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A") 'Copy Date
'.Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "B") 'Copy PO
dRow = dRow + 1
sCount = sCount + 1
End If
Next sRow
End With
MsgBox sCount & " rows copied", vbInformation, "Transfer Done"
End Sub