Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


75615 / 76738 ←次へ | 前へ→

【5558】Re:リストの最終行に項目を追加する方法
回答  りん E-MAIL  - 03/5/20(火) 6:47 -

引用なし
パスワード
   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

こんな感じです。
1 hits

【5554】リストの最終行に項目を追加する方法 kyon 03/5/20(火) 0:12 質問
【5558】Re:リストの最終行に項目を追加する方法 りん 03/5/20(火) 6:47 回答
【5578】Re:リストの最終行に項目を追加する方法 kyon 03/5/20(火) 23:38 お礼

75615 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free