Sub OpenFilesInFolder()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim path, fso, file, files
    Dim target As Long
    path = ThisWorkbook.path & "\"
    'xmlﾌｧｲﾙを開く処理
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set files = fso.GetFolder(path).files
    'フォルダ内の全ファイルについて処理
    For Each file In files
        'ファイルを開いてブック、シートとして取得
        Dim wb As Workbook
        Dim ws As Worksheet
        'xmlﾌｧｲﾙを開く処理
        If Right(LCase(file.name), 4) = ".xml" Then
            Workbooks.OpenXML _
                    Filename:=file.path, LoadOption:=xlXmlLoadImportToList
            Set wb = ActiveWorkbook
            Set ws = ActiveSheet
            '開いたxmlﾌｧｲﾙを順にコピペ処理
            With ThisWorkbook.Worksheets(1)
                target = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                ws.Range(ws.Cells(2, 25), ws.Cells(49, 25)).copy
                .Range(.Cells(target, 1), .Cells(target + 47, 1)).PasteSpecial Paste:=xlPasteValues
                ws.Range(ws.Cells(2, 27), ws.Cells(49, 27)).copy
                .Range(.Cells(target, 2), .Cells(target + 47, 2)).PasteSpecial Paste:=xlPasteValues
                ws.Range(ws.Cells(2, 28), ws.Cells(49, 28)).copy
                .Range(.Cells(target, 3), .Cells(target + 47, 3)).PasteSpecial Paste:=xlPasteValues
            End With
            '保存せずに閉じる
            wb.Close SaveChanges:=False
        End If
    Next file
    DoEvents
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
 

U3ViIE9wZW5GaWxlc0luRm9sZGVyKCkKICAgIEFwcGxpY2F0aW9uLlNjcmVlblVwZGF0aW5nID0gRmFsc2UKICAgIEFwcGxpY2F0aW9uLkRpc3BsYXlBbGVydHMgPSBGYWxzZQogICAgRGltIHBhdGgsIGZzbywgZmlsZSwgZmlsZXMKICAgIERpbSB0YXJnZXQgQXMgTG9uZwogICAgcGF0aCA9IFRoaXNXb3JrYm9vay5wYXRoICYgIlwiCiAgICAneG1s776M772n772y776Z44KS6ZaL44GP5Yem55CGCiAgICBTZXQgZnNvID0gQ3JlYXRlT2JqZWN0KCJTY3JpcHRpbmcuRmlsZVN5c3RlbU9iamVjdCIpCiAgICBTZXQgZmlsZXMgPSBmc28uR2V0Rm9sZGVyKHBhdGgpLmZpbGVzCiAgICAn44OV44Kp44Or44OA5YaF44Gu5YWo44OV44Kh44Kk44Or44Gr44Gk44GE44Gm5Yem55CGCiAgICBGb3IgRWFjaCBmaWxlIEluIGZpbGVzCiAgICAgICAgJ+ODleOCoeOCpOODq+OCkumWi+OBhOOBpuODluODg+OCr+OAgeOCt+ODvOODiOOBqOOBl+OBpuWPluW+lwogICAgICAgIERpbSB3YiBBcyBXb3JrYm9vawogICAgICAgIERpbSB3cyBBcyBXb3Jrc2hlZXQKICAgICAgICAneG1s776M772n772y776Z44KS6ZaL44GP5Yem55CGCiAgICAgICAgSWYgUmlnaHQoTENhc2UoZmlsZS5uYW1lKSwgNCkgPSAiLnhtbCIgVGhlbgogICAgICAgICAgICBXb3JrYm9va3MuT3BlblhNTCBfCiAgICAgICAgICAgICAgICAgICAgRmlsZW5hbWU6PWZpbGUucGF0aCwgTG9hZE9wdGlvbjo9eGxYbWxMb2FkSW1wb3J0VG9MaXN0CiAgICAgICAgICAgIFNldCB3YiA9IEFjdGl2ZVdvcmtib29rCiAgICAgICAgICAgIFNldCB3cyA9IEFjdGl2ZVNoZWV0CiAgICAgICAgICAgICfplovjgYTjgZ94bWzvvozvvafvvbLvvpnjgpLpoIbjgavjgrPjg5Tjg5rlh6bnkIYKICAgICAgICAgICAgV2l0aCBUaGlzV29ya2Jvb2suV29ya3NoZWV0cygxKQogICAgICAgICAgICAgICAgdGFyZ2V0ID0gLkNlbGxzKFJvd3MuQ291bnQsIDEpLkVuZCh4bFVwKS5Sb3cgKyAxCiAgICAgICAgICAgICAgICB3cy5SYW5nZSh3cy5DZWxscygyLCAyNSksIHdzLkNlbGxzKDQ5LCAyNSkpLmNvcHkKICAgICAgICAgICAgICAgIC5SYW5nZSguQ2VsbHModGFyZ2V0LCAxKSwgLkNlbGxzKHRhcmdldCArIDQ3LCAxKSkuUGFzdGVTcGVjaWFsIFBhc3RlOj14bFBhc3RlVmFsdWVzCiAgICAgICAgICAgICAgICB3cy5SYW5nZSh3cy5DZWxscygyLCAyNyksIHdzLkNlbGxzKDQ5LCAyNykpLmNvcHkKICAgICAgICAgICAgICAgIC5SYW5nZSguQ2VsbHModGFyZ2V0LCAyKSwgLkNlbGxzKHRhcmdldCArIDQ3LCAyKSkuUGFzdGVTcGVjaWFsIFBhc3RlOj14bFBhc3RlVmFsdWVzCiAgICAgICAgICAgICAgICB3cy5SYW5nZSh3cy5DZWxscygyLCAyOCksIHdzLkNlbGxzKDQ5LCAyOCkpLmNvcHkKICAgICAgICAgICAgICAgIC5SYW5nZSguQ2VsbHModGFyZ2V0LCAzKSwgLkNlbGxzKHRhcmdldCArIDQ3LCAzKSkuUGFzdGVTcGVjaWFsIFBhc3RlOj14bFBhc3RlVmFsdWVzCiAgICAgICAgICAgIEVuZCBXaXRoCiAgICAgICAgICAgICfkv53lrZjjgZvjgZrjgavplonjgZjjgosKICAgICAgICAgICAgd2IuQ2xvc2UgU2F2ZUNoYW5nZXM6PUZhbHNlCiAgICAgICAgRW5kIElmCiAgICBOZXh0IGZpbGUKICAgIERvRXZlbnRzCiAgICBBcHBsaWNhdGlvbi5EaXNwbGF5QWxlcnRzID0gVHJ1ZQogICAgQXBwbGljYXRpb24uU2NyZWVuVXBkYXRpbmcgPSBUcnVlCkVuZCBTdWIK