| |
了解しました。ではこんな感じのコードで、試してみて下さい。
Sub Test_MyDataCopy()
Dim Sh As Worksheet
Dim MyR As Range, C As Range
Dim Col As Integer, i As Integer, j As Integer
Dim GtR As Variant
Dim Ary(1 To 5) As Long
With Worksheets("Sheet2")
Set MyR = .Range("A2", .Range("A65536").End(xlUp))
End With
Set Sh = Worksheets("Sheet1")
For Each C In MyR
GtR = Application.Match(C.Value, Sh.Range("A:A"), 0)
If IsError(GtR) Then GoTo NLine
If C.Offset(, 1).Value = "売上" Then
Col = 3
ElseIf C.Offset(, 1).Value = "ノルマ" Then
Col = 4
End If
i = 0
For j = 2 To 10 Step 2
i = i + 1
Ary(i) = C.Offset(, j).Value
Next j
Sh.Cells(GtR, Col).Resize(5).Value = _
WorksheetFunction.Transpose(Ary)
Erase Ary
NLine:
Next
Set MyR = Nothing: Set Sh = Nothing
End Sub
|
|
Kein
- 06/3/30(木) 20:03 -
