메뉴

댓글 4

수
수메리안 채택된 답변 9월 14일
안녕하세요~
이렇게 한번 해보세요~
Option Explicit
Sub ConsolWorkbook()

    Dim varFileName As Variant
    Dim varTemp As Variant
    Dim ws As Worksheet: Set ws = Worksheets("Preface") '// 시트명 "Preface"
    Dim shtSheet As Worksheet
    Dim wrkBook As Workbook
    Dim rngCell As Range
    Dim i As Long
    Dim rngTarget As Range
    Dim r As Long                   '// 파일명 기록용 행 인덱스
    Application.ScreenUpdating = False
    
    varFileName = Application.GetOpenFilename(filefilter:="Excel Files(*.xls),*.xls", Title:="작업파일을 모두 선택하세요", MultiSelect:=True)
    If TypeName(varFileName) = "Boolean" Then GoTo ET
    
    Set shtSheet = Worksheets.Add
    shtSheet.Move after:=Sheets(Sheets.Count)
    
    '// Preface 시트 N1 헤더 및 서식
    With ws.Range("N1")
        .Value = "파일명"           '// 헤더 텍스트
        .Font.Size = 10
        .Font.Color = vbWhite      '// 흰 글씨
        .Font.Bold = True
        .Interior.Color = vbBlack  '// 검정 배경
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    r = Application.Max(2, ws.Cells(ws.Rows.Count, "N").End(xlUp).Row + IIf(ws.Range("N1").Value <> "", 1, 0))
    If r = 2 Then ws.Range("N2").ClearContents    '// 첫 실행 시 깔끔하게
    
    For Each varTemp In varFileName
        Set wrkBook = Workbooks.Open(varTemp)
        
        '// 붙여넣기 목적지(마지막 행 아래)
        Set rngTarget = shtSheet.Cells(shtSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
        
        '// 데이터 복사(첫 시트, 헤더 제외)
        wrkBook.Worksheets(1).UsedRange.Offset(1, 0).Copy rngTarget
        Application.CutCopyMode = False
        
        '// 파일명만 Preface!N열에 순차 기록
        ws.Cells(r, "N").Value = Dir(CStr(varTemp))   '// 경로 제거한 파일명
        r = r + 1
        
        wrkBook.Close savechanges:=False
        i = i + 1
    Next varTemp
    
    If i = 0 Then
        MsgBox "오류가 발생하였습니다"
        GoTo ET
    End If
    
    Application.ScreenUpdating = True
    MsgBox "파일 통합 작업을 완료하였습니다", , "www.iExceller.com"

ET:
    '// 아래 기존 헤더 설정(필요시 유지)
    Range("A1").Value = "subassembly_no": Range("A1").Font.Size = 10
    Range("B1").Value = "idno": Range("B1").Font.Size = 10
    Range("C1").Value = "qty": Range("C1").Font.Size = 10
    Range("D1").Value = "unit": Range("D1").Font.Size = 10
    Range("E1").Value = "tube_length": Range("E1").Font.Size = 10
    Range("F1").Value = "unit_process": Range("F1").Font.Size = 10
    Range("G1").Value = "it_code": Range("G1").Font.Size = 10
    Range("H1").Value = "class_structures": Range("H1").Font.Size = 10
    Range("I1").Value = "category": Range("I1").Font.Size = 10
    Range("J1").Value = "description": Range("J1").Font.Size = 10
    Range("K1").Value = "supplier_name": Range("K1").Font.Size = 10
    Range("L1").Value = "supplier_no": Range("L1").Font.Size = 10
    Range("M1").Value = "customer_no": Range("M1").Font.Size = 10
    Range("A1").Select
End Sub
 
미
미소지기 작성자 9월 17일
@수메리안 님 @수메리안 님 
넘 감사드립니다
굉장 하십니다 ~
미
미소지기 작성자 9월 15일
@수메리안 Lv.10 님 
답변 감사드립니다
제가 문의 드린 내용이 설명이 부족했던거 같습니다 
Preface 시트에 파일명이 나오는게 아니고 통합한 시트내 "N" 열 전체에 해당 파일명이 표기 되도록 하는
것이 가능할까요 ?

수
수메리안 9월 15일
@미소지기 님 이렇게 수정해 보세요^^
Option Explicit
Sub ConsolWorkbook()
    
    Dim varFileName As Variant
    Dim varTemp As Variant
    Dim ws As Worksheet: Set ws = Worksheets("Preface") '// 시트명 "Preface"
    Dim shtSheet As Worksheet
    Dim wrkBook As Workbook
    Dim rngCell As Range
    Dim i As Long
    Dim rngTarget As Range
    Dim nRow As Long          '// 새 시트의 파일명 기록용 행 인덱스
    Dim rAdd As Long          '// 각 파일에서 추가된 행 수
    
    Application.ScreenUpdating = False
    
    varFileName = Application.GetOpenFilename(filefilter:="Excel Files(*.xls),*.xls", Title:="작업파일을 모두 선택하세요", MultiSelect:=True)
    If TypeName(varFileName) = "Boolean" Then GoTo ET
    
    Set shtSheet = Worksheets.Add
    shtSheet.Move after:=Sheets(Sheets.Count)
      
    nRow = 2  '// 새 시트의 파일명 기록 시작 행
    
    For Each varTemp In varFileName
        Set wrkBook = Workbooks.Open(varTemp)
        
        '// 붙여넣기 목적지(마지막 행 아래)
        Set rngTarget = shtSheet.Cells(shtSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
        
        '// 추가될 데이터의 행 수 계산
        rAdd = wrkBook.Worksheets(1).UsedRange.Rows.Count - 1  '// 헤더 제외
        
        '// 데이터 복사(첫 시트, 헤더 제외)
        If rAdd > 0 Then
            wrkBook.Worksheets(1).UsedRange.Offset(1, 0).Copy rngTarget
            Application.CutCopyMode = False
            
            '// 새로 생성되는 시트의 N열에 파일명 기록 (해당 행만큼)
            Dim j As Long
            For j = 0 To rAdd - 1
                shtSheet.Cells(nRow + j, "N").Value = Dir(CStr(varTemp))
            Next j
            nRow = nRow + rAdd
        End If
       
        wrkBook.Close savechanges:=False
        i = i + 1
    Next varTemp
    
    If i = 0 Then
        MsgBox "오류가 발생하였습니다"
        GoTo ET
    End If
    
    Application.ScreenUpdating = True
    MsgBox "파일 통합 작업을 완료하였습니다", , "www.iExceller.com"
    
ET:
    '// 새로 생성된 시트의 헤더 설정
    With shtSheet
        .Range("A1:N1").Value = Array("subassembly_no", "idno", "qty", "unit", "tube_length", _
                                      "unit_process", "it_code", "class_structures", "category", _
                                      "description", "supplier_name", "supplier_no", "customer_no", "file_name")
        With .Range("A1:N1")
            .Font.Size = 10
            .Font.Color = vbWhite      '// 흰 글씨
            .Font.Bold = True
            .Interior.Color = vbBlack  '// 검정 배경
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        .Range("A1").Select
    End With
End Sub

질문답변 게시판의 최근 글

스크랩 완료