質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.48%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

1734閲覧

行を増やしてから転記したい

o-k

総合スコア6

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2020/05/06 00:26

先日からこちらで何度かアドバイスをいただいております。
https://teratail.com/questions/257404

目的のシートを開いて、データを転記させるところまではできました。
ここでまたできないことがあり、教えていただきたく質問させていただきました。

転記をする内容は6行ひとかたまりのデータ2つです。
A8からO19までで、A8からO13までのかたまり(1ヶ月分、計算式あり)と、A14からO19までのかたまり(1ヶ月分、計算式あり)です。
A列には年月が入っておりますが、A8からA13は同じ年月、A14からA19はその翌月のデータが入っています。
転記をするのはA8からE19、H8からH19、K8からK19、M8からM19です。
画像のA列と青いセルが転記したい場所です。

転記をする際、転記先のデータの最下部に6行ひとかたまり(1ヶ月分、計算式あり)を追加して、
今月と先月の2ヶ月分を転記したいと思っております。

問題は6行ひとかたまりを増やす方法がわからない点です。

現在のコードのどこに何を追加したら6行分増やして2ヶ月分の転記ができるようになりますでしょうか?
ご教授のほど、よろしくお願いいたします。

イメージ説明

Sub 転記()     Dim rngFrom As Range     Dim rngTo As Range     Dim rngLast As Range     Dim c As Range     Dim ixRow As Long     Dim ixCol As Long Dim wb1 As Workbook Workbooks.Open Filename:= _ "C:\Users\ファイル\" & Range("C1").Value Set wb1 = ActiveWorkbook    Set rngFrom = ThisWorkbook.Worksheets("Sheet1").Range("A8:O19")With wb1.Worksheets("個別データ")         Set rngLast = .Cells(.Rows.Count, 1).End(xlUp)     End With     With rngFrom         Set rngTo = rngLast.Resize(.Rows.Count, .Columns.Count).Offset(1 - .Rows.Count)     End With     Set rngTo = rngTo.Range("A1:E12,H1:H12,K1:K12,M1:M12")     For Each c In rngTo         If IsEmpty(c.Value) Then             ixRow = c.Row - rngTo.Row + 1             ixCol = c.Column - rngTo.Column + 1             rngTo(ixRow, ixCol).Value = rngFrom(ixRow, ixCol).Value         End If     Next     Application.DisplayAlerts = False   ActiveWorkbook.Close True   Application.DisplayAlerts = True End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

ベストアンサー

転記をする内容は6行ひとかたまりのデータ2つです。
A8からO19までで、A8からO13までのかたまり(1ヶ月分、計算式あり)と、A14からO19までのかたまり(1ヶ月分、計算式あり)です。
A列には年月が入っておりますが、A8からA13は同じ年月、A14からA19はその翌月のデータが入っています。
転記をするのはA8からE19、H8からH19、K8からK19、M8からM19です。
画像のA列と青いセルが転記したい場所です。

どのシートの話か書いてありません。
複数シートを扱うなら、そのシートの話かをちゃんと説明してください。
回答者にコードを読んで理解しろというのは少し乱暴です。

行の挿入は、その操作をマクロの記録をしてみれば解ると思いますが、してみました?

また、考え方を変えると、あとでA列を降順で並び替えればいいので、
列があってればどの位置に貼り付けてもいいようにも思えます。
エクセルの並び替えは割と速いので、変に切った張ったするより速いかも知れません。
数式も、コピペすればいいので、とりあえず、一番下に貼り付けてもいいのでは?
と、思いました。

あと、エクセルの画面は
エクセルの画面がアクティブな状態で、
Altキー+PrintScreenキーでコピーできます。
ペイントなどのソフトで貼り付けて保存すれば、
容易にここに貼り付けられると思います。

他には、
エクセルの機能で、
セル範囲を図としてコピー

適当なシート上に貼り付け

名前を付けて保存

閉じる

ファイル名の拡張子をZipに書き換える

解凍

出来たフォルダーの中を探せば、
さっきの画像が画像ファイルであるはずです。


マクロの記録も試してみたのですが、うまく実行できませんでした。
最終行の下6行をコピーして貼り付ける

上手くできなかったなら、どうなったか説明してください。
「8行目から6行分行を挿入したい。」
がやりたい事ならそう書けばよくないですか?
責めているのではありません。よくよく考えて欲しいということです。

ExcelVBA

1Sub 転記2() 2 Dim rngFrom As Range 3 Dim rngTo As Range 4 Dim wbkTo As Workbook 5 Dim strFileName As String 6 7 With ThisWorkbook.Worksheets("Sheet1") 8 strFileName = .Range("C1").Value '転記先ファイル名取得 9 Set rngFrom = .Range("A8:O19") '転記元データセル 10 End With 11 12 '転記先を開く 13 Set wbkTo = Workbooks.Open(Filename:= _ 14 "C:\Users\ファイル\" & strFileName) 15 '転記先セル用意 16 With wbkTo.Worksheets("個別データ") 17 .Rows(8).Resize(rngFrom.Rows.Count).Insert xlShiftDown 18 Set rngTo = .Range("A8").Resize(rngFrom.Rows.Count, rngFrom.Columns.Count) 19 End With 20 21 'コピペ 22 rngFrom.Resize(, 5).Copy rngTo.Range("A1") 23 rngFrom.Columns("H").Copy rngTo.Columns("H") 24 rngFrom.Columns("K").Copy rngTo.Columns("K") 25 rngFrom.Columns("M").Copy rngTo.Columns("M") 26 27 '転記先上書き保存 28 Application.DisplayAlerts = False 29 wbkTo.Close True 30End Sub

なにかを操作する前に、
操作対象(操作したいセル範囲)を上手く表現出来てない気がします。
前にも言ったかもしれませんが、
まずは日本語で表現できるようになりましょう。

投稿2020/05/07 05:04

編集2020/05/07 08:24
mattuwan

総合スコア2136

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

o-k

2020/05/07 07:03

アドバイスありがとうございます。 説明不足すみません。 マクロを記述したファイルとは別なファイルのシート(個別データ)に転記したいと思っております。 マクロの記録も試してみたのですが、うまく実行できませんでした。 最終行の下6行をコピーして貼り付ける、というのをネットで調べながらやっていますがうまくいきません。 ご教授いただけませんでしょうか?
o-k

2020/05/07 09:36

コードのご教授ありがとうございます。 コピペしてみたのですが、うまくいきませんでした。 目的のファイルが開いて上書き保存にはなります。 ただ数値の転記ができていないのと、転記先で増やしたい6行が増えておりませんでした。 少し時間がかかりそうですが、後ほどもう一度コピペミスがないか確認してみます。
mattuwan

2020/05/07 09:52

'転記先セル用意 With wbkTo.Worksheets("個別データ") .Rows(8).Resize(rngFrom.Rows.Count).Insert xlShiftDown Set rngTo = .Range("A8").Resize(rngFrom.Rows.Count, rngFrom.Columns.Count) .activate    rngto.select .stop End With と追記して、意図したセル範囲が取得できているか確認してください。 で、問題なければ、 F8キー押下で一行づつ実行してコピペがちゃんと出来ているか確認してください。 それで良ければ上書き保存が出来てないのかなぁ。。。。? とにかくステップインで一行づつ意図通りか確認してください。 それで上手くいってるなら呪文の使い方が間違っていますので、 別の呪文でアプローチをすることになります。
o-k

2020/05/07 10:00

ありがとうございます。 試してみましたが、実行時エラー438と出ます。 F8を押していくと、.stopのところでエラーが出ます。
mattuwan

2020/05/07 10:09

あ、失礼しました。 Stopに.(ピリオド)は要らないです。 電源落します。なにかあっても明日以降になります。 上手くいかなかったら、 VBA Stop などと検索して調べてみてくれると助かりますし、 ご自分のスキルUPにつながります。
o-k

2020/05/07 10:16

アドバイスありがとうございます。 ピリオドを消してみましたが、うまくいきませんでした。 エラーは出ないようになったのですが、12行追加されるのが最下部ではなく上のほうになってしまうのと、 数値や計算式は反映されていないようです。 自分で調べて解決できたら自己解決方法のところに記載したいと思います。
mattuwan

2020/05/07 22:04

そういう風に書いているからです。 あれ? 一番下でした? 数式とかフィルダウンで十分でないですか? 最終行を行数分フィルダウンしてから、 必要なセルを書き換えては?
o-k

2020/05/08 00:51

アドバイスありがとうございます。 ネットで調べながらやってみているのですが、まだうまくできません。 .End(xlUp) .Copy.Offset(.Rows.Count) .AutoFill Destination:=.Resize(6) 一番下に6行追加ということで上記を足してみましたがダメでした。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.48%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問