[[20240415160619]]　『任意の範囲を最終行に貼り付けたい』（yu）　ページの最後に飛ぶ

『任意の範囲を最終行に貼り付けたい』（yu）

   A 　B
1  あ  い
2  か  き
3  さ  し
4

(最終行の下)
X あい
X かき
X さし

A1:B4範囲において、A列かB列を見て空欄ではない場合、
範囲内の入力データを最終行の下に値で貼り付けしたい。

わかる方いたらご教授ください。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

マクロの質問だとしてどこで詰まってますか？

 1. 空欄ではない場合の判定がわからない
→行ごとにCOUNTA関数を使うと判定できます

 2. 最終行の調べ方がわからない
→FondメソッドでA～B列を下から上方向に"*"を検索してはどうでしょうか？

 3.値貼り付け
→マクロの記録で調べることができます。

（もこな２） 2024/04/15(月) 16:28:56

もこな２さん

1,2,3はそれぞれ調べてなんとなくわかるのですが、組み合わせ方がうまくいきません。
4行すべて貼り付けることはできたのですが…

たとえば、4行のうち2行だけ入力されている場合、
A1:B2をコピーし、最終行に貼り付けたいのですが、うまくいかず…
（yu） 2024/04/15(月) 16:51:30

＞組み合わせ方がうまくいきません。
＞うまくいかず…
と言われても・・・。

どううまくいかないのか、理解がうまくいきません。

（me） 2024/04/15(月) 17:13:49

 一つ確認したい。
 下の状態ってあり得ますか？

 行  _A_  _B_
  1  あ   い 
  2          
  3       し 
  4  な

（半平太） 2024/04/15(月) 17:26:24

半平太さん

あり得ません。
（yu） 2024/04/15(月) 17:54:06

 ＞あり得ません。 
 なら、これでよさそうだが。(必要な情報が揃ってないので、分かる部分だけ）

  Range("A1").CurrentRegion.Copy　’コピーして
  [最終行の下の左端のセル].PasteSpecial xlPasteValuesAndNumberFormats　’貼付ける

（半平太） 2024/04/15(月) 19:44:57

＞4行すべて貼り付けることはできたのですが…

 そのコードを提示できませんか？

＞1,2,3はそれぞれ調べてなんとなくわかるのですが、

 片方だけ入っているパターンは無いということならもっと話は単純ですよね？
 A1:B4のうち"空白でないセル"をコピーすればよいでしょう。
 貼付先も歯抜け行が無いなら、もっとオーソドックスな方法で対処できますよね。

（もこな２） 2024/04/16(火) 07:16:58

みなさんご意見ありがとうございます。

コード貼り付けます。
コピーまではうまくいくようですが、最下行に貼りつきません。
それと、たまにクリップボードエラーが出てしまいます。

Sub Macro3()

Dim Lastrow As Long
Dim i As Long
Lastrow = Cells(Rows.Count, 1).End(xlUp)

    For i = 1 To 4
        If Cells(i, "A").Value <> "" Then
        Range(Cells(i, "A"), Cells(i, "C")).Copy
        Cells(Lastrow, "A").PasteSpecial Paste:=xlPasteValues
        Lastrow = Lastrow + 1
        End If
    Next i

End Sub
（yu） 2024/04/16(火) 08:19:18

スマホからなので適当ですが、そのアプローチなら↓では？

 Sub Macro3()
     Dim i As Long

     For i = 1 To 4
        If Cells(i, "A").Value <> "" Then
            Range(Cells(i, "A"), Cells(i, "C")).Copy
            Cells(Rows.Count, 1).End(xlUp).offset（1).PasteSpecial Paste:=xlPasteValues
        End If
     Next i
 End Sub

（もこな２） 2024/04/16(火) 08:36:17

 すると、こうかな？

 Sub Macro3()
     Dim Lastrow As Long
     Dim i As Long

     Lastrow = Cells(Rows.Count, 1).End(xlUp).Row 'Rowプロパティを取得する

     For i = 1 To Lastrow '4の決め打ちじゃなく、Lastrowまでとする(2行しかないなら、2まで）
         If Cells(i, "A").Value <> "" Then
             Range(Cells(i, "A"), Cells(i, "C")).Copy
             Cells(Lastrow + 1, "A").PasteSpecial Paste:=xlPasteValues
             Lastrow = Lastrow + 1
         End If
     Next i
 End Sub

（半平太） 2024/04/16(火) 08:43:13

もこな２さん、半平太さん

ありがとうございます！
できました。
（yu） 2024/04/16(火) 09:53:26

コメント返信：

[ 一覧(最新更新順) ]

[[20240415160619]] 『任意の範囲を最終行に貼り付けたい』（yu） ページの最後に飛ぶ

[[20240415160619]]　『任意の範囲を最終行に貼り付けたい』（yu）　ページの最後に飛ぶ