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

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

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

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

Q&A

解決済

1回答

962閲覧

【EXCEL VBA】複数のブックに分かれた転記元エクセルの内容を、転記先のデータベースブックに転記したい

退会済みユーザー

退会済みユーザー

総合スコア0

VBA

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

0グッド

0クリップ

投稿2017/12/01 05:18

###前提・実現したいこと
見積書のデータが複数のブックにわかれて保存されており、別のブックに手入力でコピペしながら、
見積書内の「見積書番号・件名・納入期日・品名・数量・単位・単 価・金 額」
」の内容が一覧化されたデータベース台帳を作っています。
まだまだ見積書があって、ひとつひとつコピペして手入力は大変なので、自動転記されるマクロをつくりたいと考えています。
P.S.マクロは初めてです。ネットや本で調べましたが、解決できず、周りにも聞ける方がいないので、こちらにたどり着きました。質問の仕方など至らないことあるかもしれませんが、もし不足している情報などがあればご指摘いただき、お手柔らかにご対応いただけると幸いです。

###発生している問題・エラーメッセージ
「マクロの記録」アイコンから、マクロを記録すると、実行する際に、ファイル名のエラーが出ます。
(転記完了した転記元ファイルは、「転記済」フォルダに移動させているため)
そこで、workbook.nameというコードに置き換えましたが、今度は、転記元にペーストされてしまったり、転記先セルへのペーストがずれてしまいます。

###該当のソースコード
Sub 見積書DB化()
'
' 見積書DB化 Macro
'

'「現在開いているブック」を定義
MsgBox ActiveWorkbook.Name
'「VBAコードを記述したブック」を定義

'入力する空白セルの指定
InputRow = Cells(Rows.Count, "a").End(xlUp).Row + 1
'見積もり番号を開いている転記元からコピーして転記先にペースト
MsgBox ActiveWorkbook.Name
Range("K2").Select
Selection.Copy
Windows("転記先_2016nov-2017oct_見積書DB.xlsm").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'件名'を開いている転記元からコピーして転記先にペースト
MsgBox ActiveWorkbook.Name
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
Windows("転記先_2016nov-2017oct_見積書DB.xlsm").Activate
InputRow = Cells(Rows.Count, "b").End(xlUp).Row + 1
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
MsgBox ActiveWorkbook.Name
'納入期日'を開いている転記元からコピーして転記先にペースト
Range("D9").Select
Application.CutCopyMode = False
Selection.Copy
Windows("転記先_2016nov-2017oct_見積書DB.xlsm").Activate
InputRow = Cells(Rows.Count, "c").End(xlUp).Row + 1
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'品名'を開いている転記元からコピーして転記先にペースト
MsgBox ActiveWorkbook.Name
Range("C18").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("転記先_2016nov-2017oct_見積書DB.xlsm").Activate
InputRow = Cells(Rows.Count, "d").End(xlUp).Row + 1
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'数量~金額'を開いている転記元からコピーして転記先にペースト
MsgBox ActiveWorkbook.Name
Range("F18:I18").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("転記先_2016nov-2017oct_見積書DB.xlsm").Activate
InputRow = Cells(Rows.Count, "e").End(xlUp).Row + 1
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

###試したこと
課題に対してアプローチしたことを記載してください

###補足情報(言語/FW/ツール等のバージョンなど)
excel2016 を使っています。

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

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

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

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

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

退会済みユーザー

退会済みユーザー

2017/12/01 06:00

早速のご返信ありがとうございます。リンクみてみます。
guest

回答1

0

ベストアンサー

いきなりこれを出すのは微妙な気がしますが
求める場所までちょっと遠そうな気がしましたので

いくつかポイント

  • Excel.ThisWorkbookを参照すると、マクロが書かれているブックを取得できる
  • 複数のシート・ブックにまたがる処理は、対象のシートを変数に入れておき、その変数経由で操作する
  • Active~Selection、親の無い(.の無い)RangeCellはExcelの状況によって指すものがコロコロ変わるので、変数に入れた方が堅牢になる

vba

1Option Explicit 2 3Sub 見積書DB化2() 4 '前提条件 5 '- 転記元のシートを前面に表示していること 6 '- 転記先のシートがこのマクロが書かれいるブックであること 7 8 If Excel.ThisWorkbook Is Excel.ActiveWorkbook Then 9 Stop '転記先と転記元が同じブック 10 Exit Sub 11 End If 12 13 '転記元のシートを取得 14 'Excelで今アクティブなシート(Excel.ActiveWorkbookは省略可) 15 Dim copyWs As Excel.Worksheet 16 Set copyWs = Excel.ActiveWorkbook.ActiveSheet 17 18 '転記先のシートを取得 19 'マクロが書かれているブックの、アクティブなシート 20 Dim pasteWs As Excel.Worksheet 21 Set pasteWs = Excel.ThisWorkbook.ActiveSheet 22 23 '入力する空白セルの指定 24 Dim pasteCell As Excel.Range '元の処理の`InputRow`に相当する場所のセル 25 Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "A").End(xlUp).Offset(1) 26 27 '見積もり番号を開いている転記元からコピーして転記先にペースト 28 Dim mitumoriCell As Excel.Range 29 Set mitumoriCell = copyWs.Range("K2") 30 31 mitumoriCell.Copy 32 pasteCell.PasteSpecial Paste:=xlPasteValues, _ 33 Operation:=xlNone, _ 34 SkipBlanks:=False, _ 35 Transpose:=False 36 'コピペは以下でも可 37 'pasteCell.Value() = mitumoriCell.Value() 38 39 40 '件名'を開いている転記元からコピーして転記先にペースト 41 '見積もり番号とやっていることはほぼ同じ 42 Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "B").End(xlUp).Offset(1) 43 44 Dim kenmeiCell As Excel.Range 45 Set kenmeiCell = copyWs.Range("D8") 46 47 kenmeiCell.Copy 48 pasteCell.PasteSpecial Paste:=xlPasteValues, _ 49 Operation:=xlNone, _ 50 SkipBlanks:=False, _ 51 Transpose:=False 52 'コピペは以下でも可 53 'pasteCell.Value() = kenmeiCell.Value() 54 55 56 '納入期日'を開いている転記元からコピーして転記先にペースト 57 '見積もり番号とやっていることはほぼ同じ 58 Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "C").End(xlUp).Offset(1) 59 60 Dim nonyuCell As Excel.Range 61 Set nonyuCell = copyWs.Range("D9") 62 63 nonyuCell.Copy 64 pasteCell.PasteSpecial Paste:=xlPasteValues, _ 65 Operation:=xlNone, _ 66 SkipBlanks:=False, _ 67 Transpose:=False 68 'コピペは以下でも可 69 'pasteCell.Value() = nonyuCell.Value() 70 71 72 '品名'を開いている転記元からコピーして転記先にペースト 73 Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "D").End(xlUp).Offset(1) 74 75 Dim hinmeiCell As Excel.Range 76 With copyWs 77 Set hinmeiCell = _ 78 .Range( _ 79 .Range("C18"), _ 80 .Range("C18").End(xlDown) _ 81 ) 82 '以下処理で選択したセルと同じものを取得しているはずです 83 'Range("C18").Select 84 'Range(Selection, Selection.End(xlDown)).Select 85 86 End With 'copyWs 87 88 89 hinmeiCell.Copy 90 pasteCell.PasteSpecial Paste:=xlPasteValues, _ 91 Operation:=xlNone, _ 92 SkipBlanks:=False, _ 93 Transpose:=False 94 'コピペは以下でも可 95 'pasteCell.Resize(hinmeiCell.Rows.Count).Value() = hinmeiCell.Value() 96 97 98 '数量~金額'を開いている転記元からコピーして転記先にペースト 99 Set pasteCell = pasteWs.Cells(pasteWs.Rows.Count, "E").End(xlUp).Offset(1) 100 101 Dim suryo_kingakuCell As Excel.Range 102 With copyWs 103 Set suryo_kingakuCell = _ 104 .Range( _ 105 .Range("F18:I18"), _ 106 .Range("F18:I18").End(xlToRight).End(xlDown) _ 107 ) 108 '以下処理で選択したセルと同じものを取得しているはずです 109 '元々入っていたので`.End(xlToRight)`を入れていますが要るのでしょうか? 110 'Range("F18:I18").Select 111 'Range(Selection, Selection.End(xlToRight)).Select 112 'Range(Selection, Selection.End(xlDown)).Select 113 114 End With 'copyWs 115 116 suryo_kingakuCell.Copy 117 pasteCell.PasteSpecial Paste:=xlPasteValues, _ 118 Operation:=xlNone, _ 119 SkipBlanks:=False, _ 120 Transpose:=False 121 'コピペは以下でも可 122 'With suryo_kingakuCell 123 'pasteCell.Resize(.Rows.Count, .Columns.Count).Value() = .Value() 124 'End With 'suryo_kingakuCell 125 126End Sub

投稿2017/12/01 14:46

編集2017/12/01 16:22
imihito

総合スコア2166

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

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

退会済みユーザー

退会済みユーザー

2017/12/06 04:13

早速の添削いただきありがとうございます。 確認とお礼が遅くなり大変恐縮です。 わかりやすく、ポイントお教えいただき大変理解しやすく助かりました。 まだ、転記先のセルにきちんとコピーペーストできず、もう少し検証してみてみます。 最初は、転記先のこちらのマクロが組み込まれたブックを開き、そのブックのファイルから転記元の見積書データを開いてブックの最前列のシートになるよう移動してから、マクロの実行を転記元からボタンおせばよろしいのですよね?
imihito

2017/12/06 11:54

転記元のブックを最前面にしてから、このマクロを実行するという手順で大丈夫です。 ただ、元の処理の行間を埋める形で作成したので、意図をくみ取り切れていない部分があるのだと思います。 私の書いた処理ではセルの選択をしていないので、少し書き換えて ブレークポイントで処理を一時停止しつつ、対象の範囲を確認しながら実行すると意図しない動作の部分がわかりやすいかと思います。 セルの選択ですが、例えば`pasteCell`がどこを指しているか確認したい場合 `pasteWs.Activate: pasteCell.Activate`や `Call Excel.Application.Goto(pasteCell)` を実行すると、そのセル範囲を選択できます。
退会済みユーザー

退会済みユーザー

2017/12/08 05:28

わかりやすいご解説ありがとうございます! 「 If Excel.ThisWorkbook Is Excel.ActiveWorkbook Then Stop '転記先と転記元が同じブック Exit Sub End If 」を 削除し、転記元の見積書データをひとつのフォルダに整理してみましたら、おかげさまで無事転記が一撃でできるようになりました! 大変にありがとうございます!! 自分でまたさらにひと手間でも減らせるように、もう少し試行錯誤してみます。 具体的にコードをお教えいただいたことで、 VBAの仕組み?みたいな、今まで本やネットで自力で調べてもイメージできなかったことがぐっとなんとなくでもわかりました!!ありがとうございます。 またわからないことが出てくると思いますが、 またお問い合わせさせていただければ幸いです。 取り急ぎのお礼までで恐縮ですが、どうぞよろしくお願いいたします!
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.51%

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

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

質問する

関連した質問