エクセルの空白セルへコピーするマクロをくむ方法

エクセルの空白のセルに指定したセルをコピーしたいのですが、
どのようなマクロを組んだらよいでしょうか？

〇今していること
　　左の表から右の表にするために
　　①10行目に1行挿入
　　②A列（食品名）の空白のセルに
　　　A4～A７のセル（料理名）を
　　　上から順番にコピー

よろしくお願いいたします。

No.5 回答者： Qchan1962 回答日時： 2020/04/01 02:03

#3です

投稿できていないと思い重複してしまいました。すみません。
メニューのデータシートなどを作成しているなら、献立入力時（これもプルダウンなどで）
使用食材、小分量、総使用量、業者を自動入力できると思いますよ。空白を開けて作成する方が大変かと、
データシートは新しいメニューが追加された時、新規登録も出来ると思います
ご質問とは関係ないですね。。すみません

No.4 回答者： googoo900 回答日時： 2020/04/01 00:11

汎用性を持たせました。

標準モジュールに貼り付けて実行です。

条件
・メニューはA4セルから始まる。
・メニューの最後のセルの下のセルは空白になっている(添付図ではA8セル)
・メニューが減っても修正不要。増えたらその下のセルは空白する必要がある。また、name_row=10を修正する。
・1つ目のメニューは10行目(name_row=10で指定)に空白行を挿入してコピーする。2つ目以降のメニューは空白セルにコピーしていく。
・食材が増減しても修正不要

Sub Yomple()
　Dim name_row As Long
　Dim menu_end As Long
　Dim i As Long

　name_row = 10
　Rows(name_row).Insert
　Cells(name_row, 1) = Cells(4, 1)

　menu_end = Cells(4, 1).End(xlDown).Row
　name_row = name_row + 1
　For i = 5 To menu_end
　　Do Until IsEmpty(Cells(name_row, 1))
　　　name_row = name_row + 1
　　Loop
　　Cells(name_row, 1) = Cells(i, 1)
　　name_row = name_row + 1
　Next i
End Sub

この回答へのお礼

ご回答いただき、ありがとうございました。

お礼が遅くなってしまい、申し訳ありませんでした。

こちらでも、うまくいきました。

始めて質問してみたのですが、
こちらに思い切って質問してみてよかったです。

汎用性を持たせてあると記載されていましたので、
こちらを読み解いて（できるかな？）
もっと範囲を広げられるように勉強してみたいと思います。

ありがとうございました。

お礼日時：2020/04/13 16:44

No.3 回答者： Qchan1962 回答日時： 2020/03/31 20:10

なるほど

空白に順次出力するのですね
Sub Sample()
　　Dim c As Range, r As Range
　　Dim i As Integer: i = 1
　　Rows(10).Insert
　　Set c = Range("A4:A7")
　　On Error Resume Next
　　For Each r In Range("A10:A36").SpecialCells(xlCellTypeBlanks)
　　　　r.Value = c(i).Value
　　　　If i = 4 Then Exit Sub
　　　　i = i + 1
　　Next
End Sub
コードの中身は検証などをして理解するようにしてくださいね。
添付図の範囲です

この回答へのお礼

何度もご回答いただき、ありがとうございました。

お礼が遅くなり、申し訳ありませんでした。

うまくいきました。

マクロ初心者でしたので、こんなことができたらいいなと
思ってはいて、こちらに思い切って質問してみてよかったです。

本当にありがとうございました。

お礼日時：2020/04/13 16:39

No.2 回答者： Qchan1962 回答日時： 2020/03/31 20:07

なるほど、

下の空白に順に入れていくのですね。。
Sub Sample()
　　Dim c As Range, r As Range
　　Dim i As Integer: i = 1
　　Rows(10).Insert
　　Set c = Range("A4:A7")
　　On Error Resume Next
　　For Each r In Range("A10:A36").SpecialCells(xlCellTypeBlanks)
　　　　r.Value = c(i).Value
　　　　If i = 4 Then Exit Sub
　　　　i = i + 1
　　Next
End Sub
こんな感じで（添付図の範囲で）
このコードが何を行っているか検証してくださいね。

No.1 回答者： Qchan1962 回答日時： 2020/03/31 16:02

行を挿入する場合は　Insert メソッドを使えば出来ます。

Rows(10).Insert
完成形の表を見ると一気に4行追加するのは、困ると思いますので
入力したいテキストのあるセルを選択して入力する場合

Sub Sample1()
　　Rows(10).Insert
　　Range("A10") = Selection.Value
End Sub

また、
A4～A7の追加テキストに何だかの目印を付け、それを頼りに入力する場合
使い勝手悪そうですがフォント設定で太字を設定して、目印にした場合の一例です。

Sub Sample()
　　Dim c As Range
　　Rows(10).Insert
　　Application.FindFormat.Clear
　　Application.FindFormat.Font.Bold = True
　　Set c = Range("A4:A7").Find(What:="*", SearchFormat:=True)
　　If c Is Nothing Then
　　　　MsgBox "太字の文字設定データがありません"
　　　　Exit Sub
　　Else
　　　　Range("A10") = c.Value
　　　　c.Font.Bold = False
　　　　If c.Row = 7 Then c.Offset(-3).Font.Bold = True
　　　　c.Offset(1).Font.Bold = True
　　End If
End Sub

初めにA4のフォントを太字にして実行、後は太字が変わります。

この回答へのお礼

回答いただき、ありがとうございます。

さっそく試してみました！！

すると、A４のセルは10行目に挿入された後に
コピーができました！

しかし、A５、A６、A７も同様に
10行目に１行挿入された後、
A10に次々とコピーされ続けてしまいました…。

私の説明がうまくできておらずに、
伝わっていなかったようですみません。

①A４→A10に1行挿入した後、コピー

②A５、A６、A７
→A９（食品名）から下の1つ目の空白セルにA5、
その下にある次の空白セルの１つにA6、
またその下にある次のセルの１つにA7と
コピーしていきたかったのです…。
（左の表でいうと、A11にA5をコピー、
A13にA6をコピー、A20にA7をコピーというような形です）

お礼日時：2020/03/31 19:05