Excel VBA質問箱 IV

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

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


13408 / 13646 ツリー ←次へ | 前へ→

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

【5554】リストの最終行に項目を追加する方法
質問  kyon  - 03/5/20(火) 0:12 -

引用なし
パスワード
   初心者です。
手探りしながら作っていますがうまくいかず、やりたいことが止まっています。
皆様のお知恵をお貸しいただけますでしょうか?

エクセルシート1のA1からA3までに項目を記入し、
その内容をシート2の最終の空白行にペーストしていき、一覧にしていく方法を探しています。

例:

シート1のA1の項目をコピーし、シート2のC2にペースト、
シート1のA2の項目をコピーし、シート2のB2にペースト、
シート1のA3の項目をコピーし、シート2のF2にペーストする。
*シート2の1行目には既にデータが入っているため、2行目から追加していく。

また新たにシート1のA1からA3までに新しい項目を記入した場合、その内容で
シート1のA1の項目をコピーし、シート2のC3にペースト、
シート1のA2の項目をコピーし、シート2のB3にペースト、
シート1のA3の項目をコピーし、シート2のF3にペーストする。

シートの最終行を自動的にみつけ、その行に項目をデータを追加していく方法を探しています。

また既にシート2にはリストがあるのですが、Bの列には必ず文字が記入されていますが、C列には項目が空白で飛んでいる個所も所々にあります。そのため、B列の最終項目に1を足した行を指定して、その列に入れていけばいいのでしょうか?
もしそうであればリストの最終行の次の空白行を見つける方法等ご存知の方いらっしゃいましたら、ぜひアドバイス宜しくお願いいたします。

【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

こんな感じです。

【5578】Re:リストの最終行に項目を追加する方法
お礼  kyon  - 03/5/20(火) 23:38 -

引用なし
パスワード
   りんさん

早速の返答ありがとうございました。
アドバイスを元に作り変えてみましたらうまくいきました!
これは結構多い質問なんですね。

しかし1点。うまくいったのも束の間、
さらに問題が発生しましたが、なんとか解決できないか、自分で試して見ます。
もしできなかったら、そのときはまたぜひアドバイスお願いいたします。

ありがとうございました。
VBAって本当にはまりますね。。。

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