我有以下代码：
Option Explicit
Dim LastRow As Long
Dim i As Long
Dim myCell2 As Range
Dim oWkSht As Worksheet
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
'-------------------------------------------
'//Head Row A1\\
'-------------------------------------------
Range("A1").Value = "Department"
Range("B1").Value = "AOS Location"
Range("C1").Value = "Article Number"
Range("D1").Value = "HFB"
Range("E1").Value = "Article Name"
Range("F1").Value = "General Comments"
Range("G1").Value = "Home Location"
Range("H1").Value = "A. Stock"
Range("I1").Value = "SGF"
Range("J1").Value = "Incoming Good"
Range("K1").Value = "M.P.QTY"
Range("L1").Value = "Pallet Qty"
Range("M1").Value = "Start Date"
Range("N1").Value = "AOS SSS"
Range("O1").Value = "End Date"
Range("P1").Value = "End Qty"
Range("Q1").Value = "Promotion week"
Range("R1").Value = "Start-Up Qty"
Range("S1").Value = "Old AWS"
Range("T1").Value = "Goal"
Range("U1").Value = "QTY Sold LW"
Range("V1").Value = "Price"
Range("W1").Value = "GM0"
Range("X1").Value = "Sales Before"
Range("Y1").Value = "Sales this Month"
Range("Z1").Value = "Total Sold this month"
'-----------------------------------------------------------------
'//Date\\
'-----------------------------------------------------------------
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
Dim r As Long
Range("AA1").Value = DateSerial(Year(Date), Month(Date), 1)
FirstDate = DateSerial(Year(Date), Month(Date), 1)
LastDate = DateSerial(Year(Date), Month(Date) + 1, 0)
r = 28
Do
FirstDate = FirstDate + 1
Cells(1, r) = FirstDate
r = r + 1
Loop Until FirstDate = LastDate
LastRow = Range("A100000").End(xlUp).Row
Range("Y2").Formula = "=SUM(Registration!AA2:Registration!BE2)"
Range("Y2").Select
Range("Y2:Y" & LastRow).Select
Selection.FillDown
Range("Z2").Formula = "=Registration!Y2*Registration!V2"
Range("Z2").Select
Range("Z2:Z" & LastRow).Select
Selection.FillDown
Selection.NumberFormat = _
"_([$€-x-euro2] * #,##0.00_);_([$€-x-euro2] * (#,##0.00);_([$€-x-euro2] * ""-""??_);_(@_)"
'--------------------------------------------------
'//Format Head, Row A1\\
'--------------------------------------------------
Range("A1", Range("XFD1").End(xlToLeft)).Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 13
End With
'--------------------------------------------------
'//Select Used rows and column and shift one row down\\
'--------------------------------------------------
Range("A1", Range(Range("A1:A" & LastRow), Range("A1", Range("XFD1").End(xlToLeft)))).Offset(1).Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
End With
'--------------------------------------------------
'//Autofit and Align all cells in rows and columns\\
'--------------------------------------------------
With Cells
.EntireColumn.AutoFit
.EntireRow.AutoFit
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlLeft
End With
'--------------------------------------------------
'//This Code will freeze the first row in the worksheet\\
'--------------------------------------------------
With ActiveWindow
.SplitColumn = 6
.SplitRow = 1
.FreezePanes = True
End With
'--------------------------------------------------
'//This code will delete all of the old products and replace them to the sheet old_products.\\
'--------------------------------------------------
Dim l As Long
Dim dst As Range
Dim sht As Worksheet: Set sht = Worksheets("Old_Products")
With Sheets("Registration")
For l = 2 To LastRow
If .Cells(l, 6).Value = "old product" Then
Set dst = sht.Range("F" & sht.Rows.Count).End(xlUp).Offset(1, -5)
.Cells(l, 6).EntireRow.Copy
dst.PasteSpecial xlPasteValues
.Cells(l, 6).EntireRow.Delete
End If
Next l
End With
'--------------------------------------------------
'//Sorting Column A in Department order\\
'--------------------------------------------------
Dim oRangeSort As Range
Dim oRangeKey As Range
' one range that includes all colums to sort
Set oRangeSort = Range("A1", Range(Range("A1:A" & LastRow), Range("A1", Range("XFD1").End(xlToLeft))))
' start of column with keys to sort
Set oRangeKey = Range("A2")
'//custom sort order\\
Dim sCustomList(1 To 28) As String
sCustomList(1) = "OTW showroom"
sCustomList(2) = "Launch Area"
sCustomList(3) = "Living"
sCustomList(4) = "Media"
sCustomList(5) = "Dining"
sCustomList(6) = "Kitchen"
sCustomList(7) = "Work"
sCustomList(8) = "Sleeping"
sCustomList(9) = "Storage"
sCustomList(10) = "Children"
sCustomList(11) = "Familly"
sCustomList(12) = "Staircase"
sCustomList(13) = "Lift"
sCustomList(14) = "OTW"
sCustomList(15) = "Koken en Eten"
sCustomList(16) = "Textiel"
sCustomList(17) = "Bed"
sCustomList(18) = "Bad"
sCustomList(19) = "Home Organisation"
sCustomList(20) = "Lighting"
sCustomList(21) = "Rugs"
sCustomList(22) = "Wall"
sCustomList(23) = "Home Decoration"
sCustomList(24) = "Self Storage"
sCustomList(25) = "CheckOut"
sCustomList(26) = "Cash Line"
sCustomList(27) = "AS IS"
sCustomList(28) = "SWFOOD"
Application.AddCustomList ListArray:=sCustomList
Sort.SortFields.Clear
oRangeSort.Sort Key1:=Range("A1:A" & LastRow), Order1:=xlAscending, Key2:=Range("B1:B" & LastRow), Order2:=xlAscending, Header:=xlYes, OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
' clean up
ActiveSheet.Sort.SortFields.Clear
Application.DeleteCustomList Application.CustomListCount
'-------------------------------------------------------
'//This code will compare the sart date for the new product and
'if it's more than one day then it will removes the product from the Registration sheet to the Planned New Products.\\
'-------------------------------------------------------
Dim j As Integer
For j = 2 To LastRow
If Sheets("Registration").Cells(j, "M").Value > Date + 1 Then
Sheets("Registration").Cells(j, "M").EntireRow.Copy Destination:=Sheets("Planned_New_Products").Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets("Registration").Cells(j, "M").EntireRow.Delete
End If
Next j
''// Stop flickering...
'--------------------------------------------------
Range("A2").Select
Application.ScreenUpdating = True
End Sub
此代码根据F列中插入的文本复制整行，并将该行粘贴到另一个工作表中。现在问题是我在Y列中有以下代码
=SUM(Registration!AA2:Registration!BE2) 'the number is from 2 to lastrow
以及Z列中的以下代码
=Registration!Y2*Registration!V2 'the number is from 2 to lastrow
现在我的问题是如何才能复制整行的值并将其粘贴到不同的工作表中？
答案 0 :(得分：0)
要复制整行值：
Dim dst As Range
Dim sht As Worksheet: Set sht = Worksheets("Old_Products")
With Sheets("Registration")
For l = lastRow to 2 Step -1
If .Cells(l, 6).Value = "old product" Then
Set dst = sht.Range("F" & sht.Rows.Count).End(xlUp).Offset(1, -5)
.Cells(l, 6).EntireRow.Copy
dst.PasteSpecial xlPasteValues
.Cells(l, 6).EntireRow.Delete
End If
Next l
End With