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

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

新規登録して質問してみよう
ただいま回答率
85.35%
マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

1回答

1799閲覧

Excel VBA マクロ 特定列のコピーを別ブックにペーストを繰り返す方法

minakosun

総合スコア4

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2021/10/22 07:56

編集2021/10/22 07:58

エクセルのファイルが日別にあり、そのすべてのブックから、31あるシートの中の商品シートの一部である二列(AJ1:AK500)の値をコピーして
集計というエクセルファイルに左詰めでペーストしていきたいと思っています。

' Macro1 Macro
'
'
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

'各シートのAJ1:AK500を末尾の集計シートに貼り付ける
Sub CreatNewSheet()
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "集計"
End Sub

Sub NameCopy()
Dim i As Long

For i = 2 To Sheets.Count Sheets(商品).Range("AJ1:AK500").Copy Sheets("集計").Cells(i, 1) Next

End Sub

まったくの初心者でいろいろ検索しながらやったのですがうまくいきません。
何かアドバイスいただけないでしょうか?

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

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

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

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

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

guest

回答1

0

ベストアンサー

こんな感じでどうでしょうか。

VBA

1Sub Merge() 2 3 Dim MergeBook As Workbook 4 Dim CurrentBook As Workbook 5 Dim CurrentPath As String 6 Dim Filename As String 7 Dim n As Integer 8 9 Application.ScreenUpdating = False 10 Set MergeBook = ThisWorkbook 11 12 Dim MergeSheet As Worksheet 13 Set MergeSheet = MergeBook.Worksheets.Add(, MergeBook.Worksheets.Count) 14 MergeSheet.Name = "集計" 15 16 CurrentPath = MergeBook.Path 17 Filename = Dir(CurrentPath & "*.xls?") 18 19 n = 0 20 Do While Filename <> Empty 21 If Filename <> MergeBook.Name Then 22 Set CurrentBook = Workbooks.Open(CurrentPath & "\" & Filename) 23 Dim ws As Worksheet 24 For Each ws In CurrentBook.Worksheets 25 ws.Range("AJ1:AK500").Copy MergeSheet.Range("A" & MergeSheet.Rows.Count).End(xlUp).Offset(1) 26 Next 27 CurrentBook.Close False 28 n = n + 1 29 End If 30 Filename = Dir 31 Loop 32 33 Application.ScreenUpdating = True 34 MsgBox n & "件のブックを処理しました。" 35End Sub

投稿2021/10/23 08:13

編集2021/10/23 08:23
jinoji

総合スコア4592

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

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

minakosun

2021/10/26 00:45

ありがとうございます! Set MergeSheet = MergeBook.Worksheets.Add の部分でエラーが出てしまい、調べたところ指定がいらないそうなので削除したら動きました! まだ、値でのコピーの部分(コピーの処理をどこで行っているのか) と改行がうまく動作していないのでそちらの原因を自分なりにも調べております。 お手数ですが何か解決策はご存じではないでしょうか?
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.35%

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

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

質問する

関連した質問