VBA Filedialog을 이용해 여러 개 엑셀 파일 하나로 통합하기 (Main 실행)

공백 없애기 

 

정렬하기

 

Formtec 서식 만들기

 

 

 

참고로 다음의 내용은 컴퓨터활용능력 자격시험과는 상관 없는 내용입니다. 

제가 취미로 하는 VBA 코드입니다. Visual Basic Application에 관심 있으신 분들을 위한 내용입니다

 

 

 

BigshiningYU/VBA_auto_Labelform: Using EXCEL VBA, you can merge the file and edit data for making formtec label (github.com)

 

GitHub - BigshiningYU/VBA_auto_Labelform: Using EXCEL VBA, you can merge the file and edit data for making formtec label

 

다음의 코드를 이용하면 같은 폴더 내의 여러 개의 엑셀파일을 복사하여

하나의 엑셀파일로 만들 수 있습니다.

 

원하는 VBA 프로그램을 만들기 위한 팁

1) Macro 이용하기 

2) MS 포럼 이용하기

3) 시중의 VBA 서적 이용하기

 

 

 

<프로그램 설명 영상>

 

 

 

 

 

<Filedialog(대화상자) 이용해서 파일 내용 복사하기 (Main 실행)>

 

     

 

 

소스코드

 

 

Sub SearchFile()

 
   
     Dim strwkbook As String

     strwkbook = ThisWorkbook.Path
     ChDir (strwkbook)
   
   
      
      
'dialog 열어 복사할 workbooks 선택하기

    Dim fd As FileDialog
    Dim pathSelectedItem As Variant
    
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
    fd.AllowMultiSelect = True
   
    If fd.Show = -1 Then   ' -1은 파일 선택한 경우, 0은 파일 선택하지 않음
   
        For Each pathSelectedItem In fd.SelectedItems

 

        ' fd.selectedItems에는 선택된 파일의 경로들을 포함하고 있습니다
        ' for i in {1,2,3} 과 같음

'선택한 엑셀파일 열기
     
     
            Workbooks.Open Filename:=pathSelectedItem

 

            '워크북 열기 workbooks.open Filename:="Book1.xlsx"
   
            Cells.Select
            Selection.Copy
  
          
            Workbooks.Open Filename:=ThisWorkbook.Name
            Sheets.Add After:=ActiveSheet
            ActiveSheet.Paste
   
'시트 이름 바꾸기

            Dim fname As String
            fname = Mid(pathSelectedItem, InStrRev(pathSelectedItem, "\") + 1)
            ActiveSheet.Name = fname
   

            ' MID 함수 인수 (문자열, 시작위치, 길이(선택사항) )
            ' -> MID("abcdef", 3) -> "cdef"
            ' InStrRev(문자열, 찾을 문자) -> 문자열의 오른쪽부터 검색하여 찾을 문자 위치를 반환하는 함수

   
'엑셀파일 닫기

            Application.CutCopyMode = False
            Workbooks(fname).Close
     
        Next pathSelectedItem
    
    
    End If

   
    Worksheets(1).Activate
    
End Sub

 

 

*같은 폴더 내에 불러올 파일과 아래의 코드를 담은 xlsm 파일을 위치시켜야 error가 발생하지 않습니다.