Скопируйте значение всей строки и вставьте его в другой лист

Question

У меня есть следующий код:

  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

Теперь мой вопрос: как я могу только скопировать значение всей этой строки и вставить его в другой лист?

Answer 1

Чтобы скопировать всю строку значений:

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