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

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

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

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

Q&A

解決済

1回答

2851閲覧

VBAでのコピーペーストが上手く動かない(複数回実施される)

hanabi.

総合スコア16

VBA

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

0グッド

0クリップ

投稿2019/04/02 07:54

前提・実現したいこと

お世話になります。Excel VBA初心者です。

Excelを用いて勤怠管理を行っており、スタッフ増員に伴い、下記流れをExcel VBAで作成したボタンで自動化できるようにしたいと考えています。

  1. フォルダ内にあるすべてのブックをボタンひとつで開く
  2. 『集計』シートをボタンで作成する
  3. 各シートの氏名(例:A3)などを『集計』シートに一覧としてコピペする

発生している問題

上記1,2については問題なく実装できているのですが、3(各シートの氏名(例:A3)などを『集計』シートに一覧としてコピペする)についてどう試行錯誤しても上手くいきません。

上手くいかない具体的な内容といたしましては、コピペする際にすべての項目が2度ペーストされてしまいます。

該当のソースコード

'フォルダ内のブックをひとつのブックに展開する Sub Merge() Dim MergeBook As Workbook Dim CurrentBook As Workbook Dim CurrrentPath As String Dim Filename As String Dim n As Integer Application.ScreenUpdating = False Set MergeBook = ThisWorkbook CurrentPath = MergeBook.Path Filename = Dir(CurrentPath & "*.xls") n = 0 Do While Filename <> Empty If Filename <> MergeBook.Name Then Set CurrentBook = Workbooks.Open(CurrentPath & "\" & Filename) CurrentBook.Worksheets.Copy after:=MergeBook.Sheets(MergeBook.Sheets.Count) CurrentBook.Close n = n + 1 End If Filename = Dir Loop Application.ScreenUpdating = True MsgBox n & "件のブックを処理しました。" End Sub '各シートのA3を末尾の集計シートに貼り付ける Sub CreatNewSheet() Worksheets.Add after:=Worksheets(Worksheets.Count)   ActiveSheet.Name = "集計" End Sub '各シートのA3を末尾の集計シートに貼り付ける '以下がうまくいきません(一項目につき複数回ペーストされてしまっています) Sub NameCopy() Dim i As Long Dim n As Long m = 0 For i = 1 To Sheets.Count - 1 Sheets(i).Range("A3").Copy For n = 2 To Sheets.Count - 1 Sheets("集計").Cells(n + m, 1).PasteSpecial Next n m = m + 1 Next i End Sub

なお、各機能はシートにボタンを設置し、Callで呼び出しています。

どなたか解決策をご存知の方がいらっしゃいましたら、知恵をお貸しいただけますと幸いです。
よろしくお願いいたします。

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

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

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

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

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

torisan

2019/04/02 08:18

2度ペースト とはどういう意味でしょうか? また、2度ペーストされていると思った根拠を教えてください。
hanabi.

2019/04/02 08:34

ご指摘ありがとうございます。 『集計』シートの他に2つのシートを開いたとき、コードを動かすと各シートからA3セルの値が1つずつペーストされてほしいのですが、上記コードでは各値が2つずつ・計4つの値がペーストされてしまっています。 このような結果から2度ペーストされてるのかな?と考えました
guest

回答1

0

ベストアンサー

VBA

1Sub NameCopy() 2 Dim i As Long 3 4 For i = 2 To Sheets.Count 5 Sheets(i).Range("A3").Copy Sheets("集計").Cells(i, 1) 6 Next 7End Sub

やりたいのはこういう事じゃないですか?

左から2番目のシートのA3セルの値をコピー
集計シートの2行目のA列へ貼り付け
左から3番目のシートのA3セルの値をコピー
集計シートの3行目のA列へ貼り付け
以降シートの右端まで繰り返し

いまのコードでは、

シートの数-1だけ繰り返し   i番目のシートのA3セルをコピー   シートの数-1だけ繰り返し     貼付   次へ 次へ

という書き方になっているので、
貼付だけを無駄に繰り返すよう指示されてます。
コピーと貼り付けは、対になってないとだめですよね?

プロパティ、メソッドの探り方 マクロ記録とF1のHelpを使う

↑を参考にステップインで1行づつ実行しながら、
ローカルウィンドウで変数の中身を監視し、
意図とする数字になっているか確認してみてください。

投稿2019/04/02 09:53

編集2019/04/02 10:05
mattuwan

総合スコア2136

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

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

hanabi.

2019/04/03 00:00

回答いただきありがとうございます。 頂いたコードでコピーペーストは問題なく実行できました。 なお、ペーストが2重に行われていたことに関しましては、原因がどうやらコードではなくVBAプロジェクトに削除したと認識していたファイルが残っていることのようです。 まだ解決はしていないのですが、別の問題となりますので、再度別の質問を立ち上げさせていただきます。 この度は本当にありがとうございました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問