| |
kyon さん、おはようございます。
>シートの最終行を自動的にみつけ、その行に項目をデータを追加していく方法を探しています。
良くある質問なのですが、適切なリンク先がみつけられなかったので。
一番下の行からEndを押して↑を押すと、文字の入っている一番下が選択されます。
これを記録して、応用したのがこれ。
ちなみに実働部分はこれだけです。
Sub test1()
Dim Rpos As Long
With Worksheets("Sheet2")
Rpos = .Range("B65536").End(xlUp).Row + 1
.Cells(Rpos, 2).Value = Worksheets("Sheet1").Range("A2").Value
.Cells(Rpos, 3).Value = Worksheets("Sheet1").Range("A1").Value
.Cells(Rpos, 6).Value = Worksheets("Sheet1").Range("A3").Value
End With
End Sub
上の分に、セルのチェックなどの分岐をつけたのがこれ。
Sub test2()
'
Dim ws(1 To 2) As Worksheet, Rpos As Long, Dflg As Boolean
Set ws(1) = ThisWorkbook.Worksheets("Sheet1") '元
Set ws(2) = ThisWorkbook.Worksheets("Sheet2") '先
With ws(2)
Rpos = .Range("B65536").End(xlUp).Row + 1
End With
'Bに転記するものがあるかどうかの判定
With ws(1).Range("A2")
If .Value = "" Then
Dflg = True
Else
ws(2).Cells(Rpos, 2).Value = .Value
End If
End With
If Dflg = True Then
MsgBox "Sheet1!A2は必須", vbExclamation, "転記中止"
Else
With ws(1).Range("A1")
If .Value <> "" Then ws(2).Cells(Rpos, 3).Value = .Value
End With
With ws(1).Range("A3")
If .Value <> "" Then ws(2).Cells(Rpos, 6).Value = .Value
End With
End If
Erase ws
End Sub
こんな感じです。
|
|
- 03/5/20(火) 6:47 -
