Question

我一直在桌子上试图试图弄清楚我的大脑以试图得到答案，但在我看来，我的大脑根本不想工作。我已经走到了这一步，但似乎没有进一步......

Sub CopyValues()
    Dim i As Integer

    'Internal NCMR
    Dim wsInt As Worksheet
    Dim wsNDA As Worksheet

    'Copy Ranges
    Dim c As Variant

    'Paste Ranges
    Dim p As Range

    'Setting Sheet
    Set wsInt = Sheets("Internal NCMR")
    Set wsNDA = Sheets("NCMR Data")
    Set p = Range("B54:U54")

    With wsInt
        c = Array(.Range("B11"), .Range("B14"), .Range("B17"), .Range("B20"), .Range("B23"), .Range("Q11") _
                , .Range("Q14"), .Range("Q17"), .Range("Q20"), .Range("R25"), .Range("V23"), .Range("V25") _
                , .Range("V27"), .Range("B32"), .Range("B36"), .Range("B40"), .Range("B44"), .Range("D49") _
                , .Range("L49"), .Range("V49"))
    End With

    For i = LBound(c) To UBound(c)
        p(i + 1).Value = c(i).Value
    Next

    With wsNDA
        Worksheets("Internal NCMR").Rows("54").Copy
        Sheets("NCMR Data").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
    End With
End Sub

本主题中解释的这个脚本的重点是三个。

从工作表中取出字段，将其粘贴到一行中。
将行删除，然后将其粘贴到同一工作簿中的另一个工作表中。
从第二张纸从单元格Z1复制到刚插入的行的开头。

第三部分我还没有达到，如果有人可以帮助我，我将非常感激。

Answer 1

这是你正在尝试的吗？

Option Explicit

Sub CopyValues()
    Dim i As Integer

    'Internal NCMR
    Dim wsInt As Worksheet
    Dim wsNDA As Worksheet

    'Copy Ranges
    Dim c As Variant

    'Paste Ranges
    Dim p As Range

    'Setting Sheet
    Set wsInt = Sheets("Internal NCMR")
    Set wsNDA = Sheets("NCMR Data")
    Set p = wsInt.Range("B54:U54")

    With wsInt
        c = Array(.Range("B11"), .Range("B14"), .Range("B17"), .Range("B20"), .Range("B23"), .Range("Q11") _
                , .Range("Q14"), .Range("Q17"), .Range("Q20"), .Range("R25"), .Range("V23"), .Range("V25") _
                , .Range("V27"), .Range("B32"), .Range("B36"), .Range("B40"), .Range("B44"), .Range("D49") _
                , .Range("L49"), .Range("V49"))
    End With

    For i = LBound(c) To UBound(c)
        p(i + 1).Value = c(i).Value
    Next

    With wsNDA
        Dim Lastrow As Long

        Lastrow = .Range("B" & Rows.Count).End(xlUp).Row + 1

        wsInt.Rows("54").Copy

        With .Rows(Lastrow)
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteValues
            .Interior.Pattern = xlNone
        End With

        With .Range("A" & Lastrow)
            If Lastrow = 3 Then
                .Value = 1
            Else
                .Value = Val(wsNDA.Range("A" & Lastrow - 1).Value) + 1
            End If

            .NumberFormat = "0#######"
        End With
    End With
End Sub

将数据从工作表复制到单行，删除然后将行粘贴到另一个工作表的最后一行

1 个答案: