엑셀매크로] 리스트의 파일을 열어서 시트명과 셀값을 복사해오기

앞서 올린 매크로는 폴더에서 파일리스트를 읽어와서 엑셀시트에 뿌리는 기능입니다. 

오늘은 엑셀 시트에 뿌려진 파일을 하나씩 여는 기능을 소개합니다. 

엑셀 시트를 열고 첫번째 시트의 시트명과 A1 셀의 값을 읽어서 복사하고 시트 2에 붙이고 다시 닫는 기능입니다.

Sub testtt()

    '변수 선언 integer 는 32767 까지의 값만을 지원한다.

    Dim i As Integer

    Dim fileCnt As Integer           ' 파일의 수

    Dim sNo As Integer          ' 처리한 시트 수

    Dim cellPnt As Integer

    Dim f_name As String        '읽고자 하는 파일명

    Dim file_name As String      '파일명 전체

    '변수 기본값 할당

    i = 9           ' 첫 파일명이 아홉번째 줄에 있음.

    cellPnt = 2     ' 두번째 줄부터 써야 함.

    '처리할 파일의 갯수

    fileCnt = Sheets(1).Cells(8, 5).Value

    

    '매크로 파일명을 기록해 둡니다.

    orgBookName = ActiveWorkbook.Name

    ' 시트를 새로 만들어서 두번째 시트로 저장함. 시트명은 일자+시분초

    Sheets.Add after:=Sheets(1)

    Sheets(2).Name = Date & Hour(Time) & Minute(Time) & Second(Time)

    '반복하며 파일 처리 함

    ' 폴더열기 기능에서 파일을 읽어서 1번 시트의 9번째 위치부터 적었습니다.

    Do While i < fileCnt + 9

        sNo = 1

        '파일열기

        d_name = Sheets(1).Cells(i, 2).Value

        f_name = Sheets(1).Cells(i, 3).Value

        file_name = d_name + "\" + f_name

        Dim fs, f

        Set fs = CreateObject("Scripting.FileSystemObject")

        Set f = fs.GetFile(file_name)

        '시트 수 만큼 반복하며 확인할 것

            Workbooks.Open Filename:=file_name

        Workbooks(f_name).Activate

        

   '시트를 숨기기 해둔 상태라면 읽지 못합니다. 그래서 숨김여부를 먼저 체크합니다.

        If Sheets(1).Visible = xlSheetVisible Then

            Sheets(1).Select

            sName = Sheets(1).Name

            cValue = cells(1,1).value

            '확인된 시트명을 결과시트에 적기

            Workbooks(orgBookName).Activate

            Sheets(2).Activate

            ActiveSheet.Cells(cellPnt, 1).Value = i - 8 '번호 적어주기

            ActiveSheet.Cells(cellPnt, 2).Value = sName '시트명 가져오기

            ActiveSheet.Cells(cellPnt, 3).Value = cValue '시트명 가져오기

            

            cellPnt = cellPnt + 1

        End If

        sNo = sNo + 1

    '파일 닫기, 열었던 파일을 경고창 없이 저장 없이 종료합니다. 

    Application.DisplayAlerts = False

    Workbooks(f_name).Close SaveChanges:=False

    i = i + 1

    Loop

    MsgBox ("작업을 완료하였습니다.")

End Sub