다른 엑셀파일의 데이터 가져오기

데이터가 띄엄띄엄 있어서 ADO로 불러오기엔 까다롭다.

일단은 파일을 열어서 데이터를 가져오는 매크로

Option Base 1
Option Explicit
Sub getData()
 
    Dim rngIm As Range
    Dim strPath As String
    Dim strFile As String
    Dim varData As Variant
    Dim cntFile As Integer
    Dim i As Integer, j As Integer
    Dim wbOld As Workbook
    Dim wbNew As Workbook
 
    Application.ScreenUpdating = False
 
    '변수설정
    Set rngIm = Range("A3")
    Set wbOld = ActiveWorkbook
 
    '현재 파일과 같은 폴더로 변경
    ChDir wbOld.Path
 
    '기존자료 삭제
    rngIm.CurrentRegion.Offset(1).ClearContents
 
    '폴더 선택
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
 
        '폴더 선택 안 하면 매크로 종료
        If .SelectedItems.Count = 0 Then Exit Sub
        strPath = .SelectedItems(1) & "\"
    End With

    '폴더 내의 엑셀파일을 불러오고, 파일이 없으면 매크로 종료
    strFile = Dir(strPath & "*.xls*")
    If strFile = "" Then Exit Sub

    '폴더 내 엑셀파일 개수 카운트
    Do While strFile <> ""
        cntFile = cntFile + 1
        strFile = Dir()
    Loop

    '파일 개수만큼 배열 설정
    ReDim varData(cntFile, 9)
    strFile = Dir(strPath & "*.xls*")

    '폴더 내 모든 엑셀파일을 순환
    i = 1
    Do While strFile <> ""
        Set wbNew = Workbooks.Open(strPath & strFile)
        varData(i, 1) = i   '순
        varData(i, 2) = Range("I3") '일자
        varData(i, 3) = Range("B5") '이름

        For j = 1 To 6  '정상~합계
            varData(i, 3 + j) = Cells(7, j * 2)
        Next j

        wbNew.Close savechanges:=False
        i = i + 1
        strFile = Dir()
    Loop

    '셀에 자료 입력
    rngIm.Resize(cntFile, 9) = varData
    Application.ScreenUpdating = True
End Sub

취합본.xlsm

변사또.xlsx

성춘향.xlsx

이몽룡.xlsx

홍길동.xlsx