폴더내 모든 워크북의 특정열 복붙

VBA
작성자
H.B
작성일
2021-10-28 12:43
조회
247
엑셀버전 : M365

운영체제 : 윈도우10

안녕하세요.

하기 그림처럼 a라는 폴더안에 있는 모든 워크북(aaa,bbb,ccc)를 합쳐서 현재 엑셀의 첫번째시트 (thisworkbook.sheets(1))의 a1셀에 붙여 넣기 하고싶습니다.

 

문제는 여기서 각 aaa,bbb,ccc에서 10/2일에 해당하는 날짜의 데이터만 복붙해넣고 싶습니다만, vba구문 도움 부탁드립니다. (이부분은 일전에 match와 카운터로 1개파일에서는 성공했습니다)

 

감사합니다!

회원등급 : 20레벨
포인트 : 2292 EP
총질문 : 108 개 (마감율 : 71%)
채택답변 : 5 개
전체 4

  • 2021-10-28 15:52

  • 2021-10-28 15:56

    해당부분은 알고있습니다. 질문의 의도는 구체적으로 어떤식으로 넣을지입니다만....


  • 2021-10-28 23:50
    채택된 답변

    아래의 순서로 코드를 작성했습니다.

    1. 특정 폴더를 선택하면 폴더에 포함된 엑셀파일을 배열로 가져오는 것을
      복수개의 파일을 선택하는 (다른 사람이 만든) 코드를 사용했습니다.
      질문자님이 적절히 수정하면 될듯 합니다.
    2. 하나의 파일에 하나의 시트만 있다고 전제되지 않았기 때문에
      엑셀파일에 포함된 모든 시트를 복사하는 방식으로 했습니다.
    3. 복사하면서 만들어지는 시트명을 Sname() 과 iCount 변수에 배정하고
    4. for-loop 를 돌면서
      조건에 맞는 것을 필터하고, 복사
    5. 임시로 복사된 시트를 삭제
      - 삭제시 나타나는 다이얼로그는 그냥 두었습니다. 질문자님이 적절히 삽입하세요
    6. 자원 릴리즈

     

    Sub 엑셀파일병합()
    
        Dim cSName(0 To 100) As String
        Dim iCount As Integer
        Dim iLoop As Integer
        Dim iRow As Long
        Dim iCol As Long
        Dim xOffset As Integer
        Dim yOffset As Integer
        Dim cFindString As String       '// 필요시, 날자 타입으로 변경
        
        
        On Error Resume Next
        
        cSName(0) = "통합시트"
        
        Call MergeExcelFiles(cSName(), iCount)
        
        cFindString = "2021-10-28"
        
        
        xOffset = 1 '// 날자가 있는 컬럼의 x 위치
        yOffset = 1
            
        For iLoop = 1 To iCount - 1
        
         
            Sheets(cSName(iLoop)).Select
            
            iRow = ActiveSheet.Cells(Rows.Count, xOffset).End(xlUp).Row
            iCol = ActiveSheet.Cells(iRow, Columns.Count).End(xlToLeft).Column
            ''////////////////////////////////////////////////////////////////////////      날자 컬럼의 번호로 field:=xxx 를 변경
            ActiveSheet.Range(Cells(yOffset, xOffset), Cells(iRow, iCol)).AutoFilter Field:=1, Criteria1:="=" & cFindString & "", Operator:=xlAnd
            
            '// 필터된 영역만 복사하여 통합시트의 다음행에 붙인다.
            '// 1행에는 헤더가 있더가 가정함
            '// 데이터는 반드시 1개 이상 필터된다고 가정함
            
            Range(Cells(yOffset + 1, xOffset), Cells(iRow, iCol)).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(cSName(0)).Cells(Sheets(cSName(0)).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
            
            ActiveWindow.SelectedSheets.Delete
        
        Next
        
        Sheets(cSName(0)).Select
        Erase cSName
    
    End Sub
    
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    '///// https://chandoo.org/forum/threads/integrating-multiple-excel-in-folder-to-a-single-workbook.45438/
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    Sub MergeExcelFiles(cSName() As String, ByRef iCount As Integer)
        Dim fnameList, fnameCurFile As Variant
        Dim countFiles, countSheets As Integer
        Dim wksCurSheet As Worksheet
        Dim wbkCurBook, wbkSrcBook As Workbook
    
    
        iCount = 1
        fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
    
        If (vbBoolean <> VarType(fnameList)) Then
    
            If (UBound(fnameList) > 0) Then
                countFiles = 0
                countSheets = 0
    
                Application.ScreenUpdating = False
                Application.Calculation = xlCalculationManual
    
                Set wbkCurBook = ActiveWorkbook
    
                For Each fnameCurFile In fnameList
                    countFiles = countFiles + 1
    
                    Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
    
                    For Each wksCurSheet In wbkSrcBook.Sheets
                        countSheets = countSheets + 1
                        wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                        
                        cSName(iCount) = ActiveSheet.Name   '// 생성한 시트명을 저장한다
                        iCount = iCount + 1
                    Next
    
                    wbkSrcBook.Close SaveChanges:=False
    
                Next
    
                Application.ScreenUpdating = True
                Application.Calculation = xlCalculationAutomatic
    
                '// MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
            End If
    
        Else
            MsgBox "No files selected", Title:="Merge Excel files"
        End If
    End Sub
    

     


  • 2021-10-29 11:19

    야휘님 대단히 감사합니다!!!

    큰 도움 받았습니다^^


전체 5,260
번호 카테고리 제목 작성자 작성일 추천 조회
알림
하루 딱 "1분", 진짜 쓰는 엑셀 꿀팁 👉 "오빠두엑셀" 인스타그램 오픈! (32)
트로피 오빠두엑셀 | 2021.10.12 | 추천 24 | 조회 864
트로피 오빠두엑셀 2021.10.12 24 864
공지사항 공지사항
⭐ [더 나은 커뮤니티 문화를 위한 Q&A 글 작성 규칙] ⭐ (24)
오빠두엑셀 | 2021.10.28 | 추천 36 | 조회 2552
트로피 오빠두엑셀 2021.10.28 36 2552
26599 함수/공식
New 엑셀 조건 논리 연산자 엑셀 함수 중 합계 SUM IF 배열수식 질문입니다 (2)
namjaihee | 20:53 | 추천 0 | 조회 13
namjaihee 20:53 0 13
26591 함수/공식
New 엑셀 범위내 맨 좌측값 가져오기 첨부파일 (5) 답변완료
김성환 | 16:44 | 추천 0 | 조회 27
김성환 16:44 0 27
26590 VBA
New 엑셀 고급필터 예제파일 매크로 문제 관련 질문드립니다, 첨부파일
쌀알이 | 15:59 | 추천 0 | 조회 24
쌀알이 15:59 0 24
26586 VBA
New 고유값까지 한번에 제거할 수 있을까요? (1)
루s cos 개인대행 | 15:04 | 추천 0 | 조회 26
루s cos 개인대행 15:04 0 26
26583 함수/공식
New 범위값을 가지는 테이블에서 해당 범위안에 들어가는 값을 찾는 방법문의 첨부파일 (5) 답변완료
딸기농장 | 14:08 | 추천 0 | 조회 31
딸기농장 14:08 0 31
26579 VBA
New 다른 데이터파일을 열지않고도 데이타를 불러올수 있나요? (1)
Hellohoney | 10:35 | 추천 0 | 조회 37
Hellohoney 10:35 0 37
26572 함수/공식
New substitute 함수 질문 있습니다. (4) 답변완료
온윤 | 00:56 | 추천 0 | 조회 41
온윤 00:56 0 41
26569 VBA
New 지정양식에 데이터 불러오기 문제 관련 첨부파일 (5) 답변완료
HJ | 2022.01.28 | 추천 0 | 조회 40
HJ 2022.01.28 0 40
26565 파워쿼리/피벗
New 파워쿼리사용시 원본데이터와 다르게 쿼리로 전환되는경우(유로통화화페) (2) 답변완료
Olivia | 2022.01.28 | 추천 0 | 조회 26
Olivia 2022.01.28 0 26
26552 함수/공식
New 특정 셀부터 더하기가 궁금합니다. 첨부파일 (2)
기린 | 2022.01.28 | 추천 0 | 조회 48
기린 2022.01.28 0 48
26549 VBA
New 인덱스매치로 조회한 원본데이터를 변경(Worksheet의 Change 이벤트 프로시저를 이용한 누적 입력 방법) 기능을 다른 시트참조로 사용하기 첨부파일 (2) 답변완료
별명 | 2022.01.28 | 추천 0 | 조회 41
별명 2022.01.28 0 41
26547 파워쿼리/피벗
New 파워쿼리 병합 후 중복되는 열이 생기는 문제 (2)
Olivia | 2022.01.28 | 추천 0 | 조회 33
Olivia 2022.01.28 0 33
26543 대시보드
New 해당월 클릭시, 연매출액 계산이 가능한지 문의드립니다. (2)
모모 | 2022.01.28 | 추천 0 | 조회 47
모모 2022.01.28 0 47
26542 VBA
New 영문사이트를 getHTTP 하면 html내에있는 영문text가 한글로 바뀌어지는 문제관련 (2)
seob**** | 2022.01.28 | 추천 0 | 조회 37
seob**** 2022.01.28 0 37
26539 함수/공식
New 모든 시트의 특정 셀 합계 구하는 방법을 알고싶습니다. 첨부파일 (3)
이주 | 2022.01.28 | 추천 0 | 조회 51
이주 2022.01.28 0 51
26535 차트/그래프
New 차트 틀고정 문의 드립니다. (4)
박주형 | 2022.01.28 | 추천 0 | 조회 38
박주형 2022.01.28 0 38
26529 VBA
New vba 재고관리프로그램 강의 Get_db 함수 관련 (2) 답변완료
탄만두 | 2022.01.27 | 추천 0 | 조회 47
탄만두 2022.01.27 0 47
26527 VBA
New 그룹별 빈셀 삭제 방법 문의 드립니다. 첨부파일 (1)
Wland | 2022.01.27 | 추천 0 | 조회 30
Wland 2022.01.27 0 30
26525 함수/공식
New 비교 조건 어떻게 처리하면 될까요ㅠ (6) 답변완료
LiNe | 2022.01.27 | 추천 0 | 조회 44
LiNe 2022.01.27 0 44
26522 VBA
New 재고관리 달력입력폼 X를 누르면 오전12:00:00 이라고 표시됩니다ㅠㅠ (1)
탄만두 | 2022.01.27 | 추천 0 | 조회 35
탄만두 2022.01.27 0 35
26517 함수/공식
New 함수질문 1:다 Lookup 와일드카드 사용 첨부파일 (3)
H.B | 2022.01.27 | 추천 0 | 조회 44
H.B 2022.01.27 0 44
26514 피벗테이블
New [피벗테이블 기준값]과의 차이 첨부파일 (1)
gh**** | 2022.01.27 | 추천 0 | 조회 32
gh**** 2022.01.27 0 32
26513 피벗테이블
New 피벗테이블 기준갑과의 차이 첨부파일 (1)
gh**** | 2022.01.27 | 추천 0 | 조회 31
gh**** 2022.01.27 0 31
26511 VBA
New MSXML 또는 WinHttp 크롤링할 때 브라우저가 뜨지 않게 하는 방법 (2)
나는나 | 2022.01.27 | 추천 0 | 조회 34
나는나 2022.01.27 0 34
26508 함수/공식
New 중복데이터 찾아서 삭제하는 방법(3천개정도 됩니다) 첨부파일 (3) 답변완료
따뜻한아메리카노 | 2022.01.27 | 추천 0 | 조회 49
따뜻한아메리카노 2022.01.27 0 49
26504 VBA
New HTML 코드안의 원하는 값 가져오기 (1)
엑셀초보(LV.1) | 2022.01.27 | 추천 0 | 조회 35
엑셀초보(LV.1) 2022.01.27 0 35
26501 VBA
New VBA 유저폼 리스트박스에 배열 정렬방법문의드립니다 (1)
98e | 2022.01.27 | 추천 0 | 조회 33
98e 2022.01.27 0 33
26498 VBA
New vba 그래프 영역 변경 구문 간단질문 (2) 답변완료
H.B | 2022.01.27 | 추천 0 | 조회 28
H.B 2022.01.27 0 28
26497 함수/공식
New 엑셀 수식 계산 (7)
스미스 | 2022.01.27 | 추천 0 | 조회 59
스미스 2022.01.27 0 59
26489 함수/공식
New 특정 셀이 공란일시, 저장이 안되게끔 할 수 있을까요? (8) 답변완료
쿠몬은내친구 | 2022.01.27 | 추천 1 | 조회 51
쿠몬은내친구 2022.01.27 1 51