통합문서 합치기 chatgpt

Sub MergeWorkbooksWithDialog()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    Dim targetFile As Variant
    
    'Show the Open dialog box to select the target file
    targetFile = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
    If targetFile = False Then Exit Sub
    
    'Turn off calculation to speed up the code
    CalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual
    
    'Create a new workbook to hold the merged data
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    rnum = 1
    
    'Set the path to the folder that contains the workbooks to be merged
    MyPath = "C:\Folder\"
    
    'Set the file filter to Excel files only
    FilesInPath = "*.xlsx"
    
    'Create an array of file names
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    FNum = 0
    MyFiles = Dir(MyPath & FilesInPath)
    If IsEmpty(MyFiles) Then
        MsgBox "No files found"
        Exit Sub
    End If
    
    'Loop through each file in the array
    Do While MyFiles <> ""
        'Open the file and set the source range to the first sheet of the workbook
        Set mybook = Workbooks.Open(MyPath & MyFiles)
        Set sourceRange = mybook.Worksheets(1).UsedRange
        
        'Copy the data from the source range to the destination range in the new workbook
        Set destrange = BaseWks.Range("A" & rnum)
        sourceRange.Copy destrange
        
        'Adjust the row number for the next file
        rnum = rnum + sourceRange.Rows.Count
        
        'Close the source workbook
        mybook.Close savechanges:=False
        
        'Get the next file name
        MyFiles = Dir
    Loop
    
    'Reset calculation mode
    Application.Calculation = CalcMode
    
    'Auto-fit the columns in the destination range
    BaseWks.Columns.AutoFit
    
    'Activate the new workbook
    BaseWks.Parent.Activate
    
    'Save the merged data to the selected target file
    BaseWks.Parent.SaveAs targetFile
End Sub