엑셀 VBA #93 / 특정 폴더 내, 파일통합_VBA필수 [VBA]

Sub Data_gether_from_otherfile()
      Dim strPath As String, fName As String
      Dim wb As Workbook
      Dim rngS As Range
      Dim cntRows As Long
      
      Application.ScreenUpdating = False
      
      strPath = "C:\Users\sss\ddd\바탕 화면\조사활동\가나다조사\팀별일일보고\"
      '위 코드의 문제점 해결위해 아래처럼 한다
      'strPath = Environ("userprofile") & "\바탕 화면\조사활동\가나다조사\팀별일일보고\"
      fName = Dir(strPath & "*.xls*")
      
      If fName = "" Then
            MsgBox "폴더내 엑셀 파일 없음"
            Exit Sub
      End If
      
      Do While fName <> ""
            Set wb = Workbooks.Open(Filename:=strPath & fName, UpdateLinks:=0)
            Set rngS = wb.Sheets(1).UsedRange
            Set rngS = rngS.Offset(1).Resize(rngS.Rows.Count - 1)
            cntRows = rngS.Rows.Count
            
            'rngS.Copy Sheet1.Cells(Rows.Count, "a").End(3)(2)
            '위 코드는 속도가 느리므로 아래처럼하자
            Sheet1.Cells(Rows.Count, "a").End(3)(2).Resize(cntRows, 17) = rngS.Value
            
            wb.Close
            fName = Dir
      Loop
      
      Application.ScreenUpdating = True
      
End Sub

본 코드의

장점 : 취합파일과 복사대상파일의 경로가 달라도 됨

단점 : 지정된 폴더의 모든 엑셀파일이 모여짐.

https://www.youtube.com/watch?v=IOFTEpvTw00&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=94