□ 파일명 찾기 VBA
Sub 화일명찾기()
Dim iRow As Integer, sFile As String
디렉토리 = ThisWorkbook.Path & "\" ' 현재화일의 디렉토리 + \
sFile = Dir(디렉토리 & "*.xls") ' *_화성.xls를 포함한 모든화일
Do While sFile <> "" ' 루프(loop)를 시작
iRow = iRow + 1 ' 표시위치
[A1].Offset(iRow, 0) = sFile ' 위치에 화일명 표시
sFile = Dir ' 다음 화일명을 읽기
Loop
End Sub
□ 파일통합 VBA
Sub 화일통합()
If [A2] = "" Then Exit Sub ' A2가 공백이면 종료 - 불러온화일이 없으면
Application.ScreenUpdating = False ' 작업상황 화면표시 중단
Application.DisplayAlerts = False ' 엑셀 선택창 표시 중단 - 디폴트로 선택함(저장/종료시 대화상자)
Dim myData, Target
디렉토리 = ThisWorkbook.Path & "\" ' 현재화일의 디렉토리 + \
Set myData = Range("A2", [A2].End(xlDown)) ' 불러온 원본화일 리스트
Set Target = [b2] ' 첫 통합화일명 저장
Workbooks.Add ' 새로운 화일 생성
ActiveWorkbook.SaveAs Target ' 통합화일명으로 저장
For Each Target In myData ' 원본리스트에 대하여
'-----------------------------------------------------------------------------------------
' 원본/통합화일의 3행은 머릿말, 4행부터는 자료일때 복사루틴
'-----------------------------------------------------------------------------------------
If [A3] = "" Then ' 통합화일 A3체크 - 처음복사인지
[A3].EntireRow.Select ' 3행 전체 선택
Workbooks.Open 디렉토리 & Target ' 원본화일 오픈
Rows("3:3").Select ' <<-수정시 이부분 변경 ' 3행부터 - 머릿말포함
Else
[A3].End(xlDown).Offset(1, 0).EntireRow.Select ' 마지막행 + 1행 이동한 행 전체 선택
Workbooks.Open 디렉토리 & Target ' 원본화일 오픈
Rows("4:4").Select ' <<-수정시 이부분 변경 ' 3행부터 - 머릿말 제외
End If
Range(Selection, Selection.End(xlDown)).Select ' 마지막행 까지 선택
Selection.Copy ' 복사
ActiveWindow.Close ' 원본 닫기
ActiveSheet.Paste ' 붙여넣기
'-----------------------------------------------------------------------------------------
' 다음 통합화일 체크후 종료/신규 화일만들기 루틴
'-----------------------------------------------------------------------------------------
If Target.Offset(1, 1) = "" Then ' 원본리스트 다음이 없으면
ActiveWorkbook.SaveAs Target.Offset(0, 1) ' 원본리스트 우측 - 통합화일명으로 저장
ActiveWindow.Close ' 통합화일 닫기
Exit For ' 작업종료
End If
If Target.Offset(0, 1) <> Target.Offset(1, 1) Then ' 현위치 통합화일명이 다음행과 다르면
ActiveWorkbook.SaveAs Target.Offset(0, 1) ' 원본리스트 우측 - 통합화일명으로 저장
ActiveWindow.Close ' 통합화일 닫고
Workbooks.Add ' 새로운화일 열기
ActiveWorkbook.SaveAs Target.Offset(1, 1) ' 새로운화일명 다음 통합화일명으로 저장
End If
Next
Application.DisplayAlerts = True ' 선택창표시 활성화
Application.ScreenUpdating = True ' 작업상황표시 활성화
End Sub