1

頭を机にぶつけて答えを得ようとして脳を壊そうとしていますが、脳が働きたくないようです。ここまで来ましたが、それ以上はないようです...

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

このトピックで説明されているように、このスクリプトのポイントは 3 つあります。

  1. シートからフィールドを取得し、それらを行に貼り付けます。
  2. 行を削除して、同じワークブックの別のシートに貼り付けます。
  3. セル Z1 の 2 番目のシートから、挿入したばかりの行の先頭にコピーします。

私がまだ到達していない 3 番目の部分です。

4

1 に答える 1

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
于 2012-04-24T15:32:35.207 に答える