[[20190923085010]]　『開いてるExcelのデータを全て１つのExcelブックに』（ケイ）　ページの最後に飛ぶ

『開いてるExcelのデータを全て１つのExcelブックにまとめたい』（ケイ）

複数のダウンロードしたデータを下記のサンプルコードを使ってまとめてます。
結合まではうまくできてました。以下2点問題があります。
初心者のため是非お力添えを頂きたく存じます。

■問題点
?@開いてるExcelブックには2つの固定された名前のシート合計と月別があり２つとも結合してしまう。※月別だけのシートを結合したいです。
?A1行目には同じ項目名の（売上、販売量など）タイトル行がはいってますが
1行目のタイトル行もこのサンプルコードだと消えてしまいます。
1行目のタイトル行を残したまま

?@のシート名は固定となります。
?A1行目の文字列は基本固定となり同じ文字列の複数データを結合することを想定してます。

?B?@?Aの内容を修正した全サンプルコードをいただけますと大変助かります。

大変お手数ですがご教授よろしくお願いいたします

Option Explicit

Sub folder()

If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
Range("b2").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If

End Sub

Sub merge()

'シート［merge］を削除
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("merge").Delete
Application.DisplayAlerts = True

'シート［merge］を一番右に追加
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "merge"

'フォルダの場所を変数に入れる
Dim Folder_path
Folder_path = ThisWorkbook.Worksheets("folder").Range("b2").Value

'結合するブックを変数に入れる
Dim FileType
If Worksheets("folder").Range("b1").Value = "Excel" Then
FileType = "\*.xls*"
Else
FileType = "\*.csv"
End If

Dim MergeWorkbook
MergeWorkbook = Dir(Folder_path & FileType)

'指定したフォルダから、Excelファイルを探す
Do Until MergeWorkbook = ""
Workbooks.Open Filename:=Folder_path & "\" & MergeWorkbook

Dim MergeWorkbook_data '結合するブック内のシートのデータ数
Dim ThisWorkbook_data '結合先のシートのデータ数

Dim i
For i = 1 To Workbooks(MergeWorkbook).Worksheets.Count

MergeWorkbook_data = Workbooks(MergeWorkbook).Worksheets(i).Range("a" & Rows.Count).End(xlUp).Row
ThisWorkbook_data = ThisWorkbook.Worksheets("merge").Range("a" & Rows.Count).End(xlUp).Row

Workbooks(MergeWorkbook).Worksheets(i).Rows("2:" & MergeWorkbook_data).Copy ThisWorkbook.Worksheets("merge").Range("a" & ThisWorkbook_data + 1)
Next

'結合するブックを閉じる
Application.DisplayAlerts = False
Workbooks(MergeWorkbook).Close
Application.DisplayAlerts = True

'次のブックを探しに行く
MergeWorkbook = Dir()
Loop

End Sub

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

文字化け出てたため修正します。

■問題点
1,開いてるExcelブックには2つの固定された名前のシート合計と月別があり２つとも結合してしまう。※月別だけのシートを結合したいです。

2,1行目には同じ項目名の（売上、販売量など）タイトル行がはいってますが
1行目のタイトル行もこのサンプルコードだと消えてしまいます。
1行目のタイトル行を残したまま結合するsheetはタイトル行を削除して2行目から結合したい

1,2の内容を修正した全サンプルコードをいただけますと大変助かります。
（ケイ） 2019/09/23(月) 09:07

まずは、現在のコードを１行ずつ何をしていいるか
日本語に置き換えてみてください。

（マナ） 2019/09/23(月) 09:32

 こんにちは！

 先ず一番気になったのは、、エラーをトラップするところ、、
 基本的にエラーが発生しない様なコードを書いた方がいいと思います。

 次に、変数の宣言は最初にまとめた方がいいと思いますが、、これは個人差があるのでお好きな様に、、、

 次に、Set　と　With　を使った方が見通しがいい様に思いますけど、、、これも個人差ですね(^^;

 後、、MergeWorkbook_data　何てのは　数？でしょ？？？　i　とか　n　とか　k　とか　シンプルな方が見やすくないですか？？

 これも個人差(￣▽￣;)

 それと、、肝心の　月別　だけ　なら　それを判定するコードが必要かとおもいます。

 あと、一行目が消えるのは、これまた定番で、、Offset(1)　です。

 小言ばっかりになりましたが、、お気を悪くなされません様に。。。。

 では、、では、、

 あっ、、テストしてません。。。(おっっい！！！)

 後は、応用してください。。。

 Option Explicit
Sub folder()
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
    Range("b2").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Sub
Sub merge()
Dim wb As Workbook
Dim Sh As Variant
Dim i As Long
Dim Folder_path As String
Dim FileType As String
Dim MergeWorkbook As String
Dim MergeWorkbook_data As Long   '結合するブック内のシートのデータ数
Dim ThisWorkbook_data As Long   '結合先のシートのデータ数
Dim MyFlg As Boolean
Sh = Array("merge", "folder")
For i = LBound(Sh) To UBound(Sh)
    If Not Evaluate("=ISREF(" & Sh(i) & "!A1)") Then Sheets.Add.Name = Sh(i)
    If Sh(i) = "merge" Then Worksheets(Sh(i)).Cells.Clear
Next
Worksheets("merge").Move , Worksheets(Worksheets.Count)
Folder_path = ThisWorkbook.Worksheets("folder").Range("b2").Value
If Worksheets("folder").Range("b1").Value = "Excel" Then
    FileType = "\*.xls*"
Else
    FileType = "\*.csv"
End If
MergeWorkbook = Dir(Folder_path & FileType)
Do Until MergeWorkbook = ""
    Set wb = Workbooks.Open(Filename:=Folder_path & "\" & MergeWorkbook)
    With ThisWorkbook
'        For i = 1 To wb.Worksheets.Count
            i = 2
'            If wb.Worksheets(i).Name Like "*月別*" Then
                MergeWorkbook_data = wb.Worksheets(i).Range("a" & Rows.Count).End(xlUp).Row
                ThisWorkbook_data = .Worksheets("merge").Range("a" & Rows.Count).End(xlUp).Offset(1).Row
                ThisWorkbook_data = .Worksheets("merge").Range("a1").CurrentRegion.Rows.Count + 1
                If MyFlg Then
                    wb.Worksheets(i).Rows("2:" & MergeWorkbook_data).Copy .Worksheets("merge").Range("a" & ThisWorkbook_data)
                Else
                    wb.Worksheets(i).Rows("1:" & MergeWorkbook_data).Copy .Worksheets("merge").Range("a" & ThisWorkbook_data)
                    MyFlg = True
                End If
'            End If
'        Next
    End With
    wb.Close False
    MergeWorkbook = Dir()
Loop
ThisWorkbook.Worksheets("merge").Rows("1:1").Delete Shift:=xlUp
Set wb = Nothing
End Sub
（SoulMan） 2019/09/23(月) 10:21

細かいご説明までいただきましてありがとうございます。
試してみたのですがファイル探しまではマクロボタンで行えたのですが
マクロボタンで結合ボタンを作成して押すデータは結合されずに空白のmergeのシートができてしまいました。お手数ですがご教授いただけないでしょうか
（ケイ） 2019/09/23(月) 13:37

マナさんのアドバイスにありますが、どの行で何をしているか調べていますか？

たとえば、いまうまくいかなかったそのマクロですが、どのシートのb2セルにファイルパスが記入されましたか？
（黄色い循環参照） 2019/09/23(月) 14:10

folderのシートのB2セルにファイパスが記入されました。各コードの意味はインターネットで調べているのですがまだそれ以上の確認する力がなく原因がまだわからないです。ご教授いただけますと幸いです。
（ケイ） 2019/09/23(月) 14:28

 月別のシートがないんだと思うので

 If wb.Worksheets(i).Name = "月別" Then
 ↓
 If wb.Worksheets(i).Name Like "*月別*" Then

 でどうでしょうか？？
（SoulMan） 2019/09/23(月) 14:45

確認したのですが4つのファイルがあって4回シートは動作してるのですがどうもないみたいです。インデックスで数字の2とかでやればできるのでしょうか？こちらの方法だとどのようにすればいいのかご教授いただけないでしょうか？もうちょっとでできそうな気がしてます
（ケイ） 2019/09/23(月) 15:04

 上のコードを直しておきましたので試してみて下さい。
（SoulMan） 2019/09/23(月) 15:14

SoulManさん、すごいですできました。ありがとうございます。感動です^^あと1行目のタイトル行がきえてしまうのですがこちらはどうすれば残せれるでしょうか？
（ケイ） 2019/09/23(月) 15:20

1行目のタイトル行だけ残して、結合するファイルは全て2行目から結合したいです
（ケイ） 2019/09/23(月) 15:22

 それだと↓これが空打ちだと思うので、取り敢えず、、、

 ThisWorkbook_data = .Worksheets("merge").Range("a" & Rows.Count).End(xlUp).Offset(1).Row

 絶対にある列に変更してみて下さい。

 例えば、、B列だと

 ThisWorkbook_data = .Worksheets("merge").Range("B" & Rows.Count).End(xlUp).Offset(1).Row

 それから、、感動するようなことじゃないですから(^^;
（SoulMan） 2019/09/23(月) 15:27

 それでもだめだったら、、↓みたいにするとか、、
 ThisWorkbook_data = .Worksheets("merge").Range("a1").CurrentRegion.Rows.Count + 1
（SoulMan） 2019/09/23(月) 15:34

 ThisWorkbook_data = .Worksheets("merge").Range("a" &Rows.Count).End(xlUp).Offset(1).Row
↑ここの列を変更すればいいんですね？２つともためしましたがまだ1行目は空白のままでした、1行目は文字列になります。本当に助かってます。ありがとうございます。もう少しご教授いただけないでしょうか　　　　
（ケイ） 2019/09/23(月) 15:42

 なんかいつもの私らしくボロボロになってきた様な気がしますが、、(^^;

 そもそも、、よくよく見るとタイトル行ってないですよね？？

 どこかにタイトル行を作るか？一回目だけタイトルを含めてコピーして最後に一行目を削除しないといけないのかな？？？

 取り敢えず上のコードを直してみましたのでお試しください。。。
（SoulMan） 2019/09/23(月) 16:01

すみません。タイトルいてなかったです。無事にできました^=^ お時間いただきまして本当にありがとうございます。
（ケイ） 2019/09/23(月) 16:10

コメント返信：

[ 一覧(最新更新順) ]

[[20190923085010]] 『開いてるExcelのデータを全て１つのExcelブックに』（ケイ） ページの最後に飛ぶ

[[20190923085010]]　『開いてるExcelのデータを全て１つのExcelブックに』（ケイ）　ページの最後に飛ぶ