问题
I want to execute a copy and paste function based upon certain criteria being selected.
I have a macro to clear the data in the "NEW PO" tab once an "order" is written and the information is copied to the "POs" tab.
A copy and paste script copies 3 cells from the "NEW PO" tab to the "POs" tab.
Sub Copy_Data()
Dim Count, Qty As Long
Dim CatRng, MonthRng, SDate, CxlDate, PoNumb, Vendor As Range
Dim Total As Currency
Dim StrTarget As String
Dim Row, PORow, Col As Integer
Set CatRng = Sheets("NEW PO").Range("G20:G43")
Set MonthRng = Sheets("POs").Range("L122:W122")
StrTarget = Sheets("New PO").Range("V12")
Set SDate = Sheets("New PO").Range("T12")
Set CxlDate = Sheets("New PO").Range("T13")
Set PoNumb = Sheets("New PO").Range("N10")
Set Vendor = Sheets("New PO").Range("D14")
Count = 0
For Count = 0 To 99
Total = 0
Qty = 0
'So that the values reset each time the cat changes
For Each cell In CatRng
'To get the row number then total the required information
If cell.Value = Count Then
Row = cell.Row
Qty = Qty + Sheets("NEW PO").Range("S" & Row).Value
Total = Total + Sheets("NEW PO").Range("Z" & Row).Value
'I guessed ext cost only as it has been totaled at the bottom,
'this is easily changed though
End If
Next cell
'Now put the totals into a PO only if there is a quantity of items
If Qty > 0 Then
PORow = Sheets("POs").Range("K1048576").End(xlUp).Row + 1
'I'll let you sort the PO number and other fields out but the main 3 are done below
With Sheets("POs")
.Range("I" & PORow).Value = Qty
.Range("K" & PORow).Value = Count
.Range("C" & PORow).Value = SDate
.Range("D" & PORow).Value = CxlDate
.Range("B" & PORow).Value = PoNumb
.Range("F" & PORow).Value = Vendor
'My understanding here is that the target month in T12 is in the same format as
'the anticipated Receipt month, I hope this is what you were looking for
For Each cell In MonthRng
If cell.Value = StrTarget Then
Col = cell.Column
.Cells(PORow, Col).Value = Total
'Used .cells here as both column and row are now integers
'(only way i can ever get it to work)
End If
Next cell
End With
End If
Next Count
End Sub
I want to filter/validate the quantity (column S) Column Z and extended cost from the "NEW PO" tab based on the category selected in Column G. I then want to paste that to the "POs" tab, under the correct month the order is being written, which is determined by the start date in cell T12 on the "NEW PO" tab.
Additionally when the category changes, for example from 00 to 01, it should drop to the next row on the "POs" tab and change category as well.
Screen shots of the two tabs.
回答1:
Okay, this seems to fit what you want it to do, please let me know if it doesn't.
It's a bit long as I just whacked this together between meetings but it does the job. You can use the row and column indexes to manipulate any other data you wish to pull across or amend which cost you want to be totaled up.
Sub Test()
Dim Count, Qty As Long
Dim CatRng, MonthRng As Range
Dim Total As Currency
Dim Row, PORow, Col As Integer
Set CatRng = Sheets("NEW PO").Range("G19:G43")
Set MonthRng = Sheets("POs").Range("L122:W122")
Count = 0
For Count = 0 To 99
Total = 0
Qty = 0
'So that the values reset each time the cat changes
For Each Cell In CatRng
'To get the row number then total the required information
If Cell.Value = Count Then
Row = Cell.Row
Qty = Qty + Sheets("NEW PO").Range("T" & Row).Value
Total = Total + Sheets("NEW PO").Range("AA" & Row).Value
'I guessed ext cost only as it has been totaled at the bottom,
'this is easily changed though
End If
Next Cell
'Now put the totals into a PO only if there is a quantity of items
If Qty > 0 Then
PORow = Sheets("POs").Range("J1048576").End(xlUp).Row + 1
'I'll let you sort the PO number and other fields out but the main 3 are done below
With Sheets("POs")
.Range("I" & PORow).Value = Qty
.Range("J" & PORow).Value = Count
'My understanding here is that the target month in T12 is in the same format as
'the anticipated Receipt month, I hope this is what you were looking for
For Each Cell In MonthRng
If Cell.Value = .Range("T12").Value Then
Col = Cell.Column
.Cells(PORow, Col).Value = Total
'Used .cells here as both column and row are now integers
'(only way i can ever get it to work)
End If
Next Cell
End With
End If
Next Count
End Sub
来源：https://stackoverflow.com/questions/37555692/copy-and-paste-based-on-filter