前提・実現したいこと
お世話になります。Excel VBA初心者です。
Excelを用いて勤怠管理を行っており、スタッフ増員に伴い、下記流れをExcel VBAで作成したボタンで自動化できるようにしたいと考えています。
- フォルダ内にあるすべてのブックをボタンひとつで開く
- 『集計』シートをボタンで作成する
- 各シートの氏名(例: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で呼び出しています。
どなたか解決策をご存知の方がいらっしゃいましたら、知恵をお貸しいただけますと幸いです。
よろしくお願いいたします。
回答1件
あなたの回答
tips
プレビュー