다중 엑셀 복사하기 - 1

오늘 같이 일하는 회사동료가 엑셀파일 합치고, 거기서 데이터가공하고

숫자 뽑는걸 편하게 하라고 일을 도와줬습니다.

 

해외법인 자금일보중에 특정국가시트만 복사해서 

공백있는 칸들을 제외하고, 복사해서 

30개이상의 엑셀파일을 조지는일을 비주얼베이직으로 만들어줘서

도와줬습니다.

 

먼저 

엑셀일 킨다음

ALt + F11키를 누른후에

위  삽입 -> 모듈에 들어갑니다.

그리고 나서 아래  내용을 복사해주면 되는데

Sub MergeAndProcessFilesWithSelectiveCopyAndValueInsertion()
    Dim ws As Worksheet, newWs As Worksheet
    Dim wb As Workbook, newWb As Workbook
    Dim myPath As String, myFile As String
    Dim lastRow As Long, i As Long, nextRow As Long
    Dim valueToCopy As Variant

    ' 폴더 경로 업데이트 아래폴더안의 모든 xlsx파일을 대상으로합니다.
    myPath = "C:\test\"
    myFile = Dir(myPath & "*.xlsx*")

    ' 새 워크북 생성
    Set newWb = Workbooks.Add
    Set newWs = newWb.Sheets(1)
    nextRow = 1 ' 새 시트에 데이터를 붙여넣을 시작 행

    ' 폴더 내의 모든 파일을 순회 붉은색글자는 시트이름입니다.
    Do While myFile <> ""
        Set wb = Workbooks.Open(Filename:=myPath & myFile)
        Set ws = wb.Sheets("베트남")
        valueToCopy = ws.Range("I6").Value ' I6의 값 복사

        ' K열의 마지막 행 찾기
        lastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row

        ' 모든 행 순회
        For i = 1 To lastRow
            If ws.Cells(i, "K").Value = 2 Then
                ' K열의 값이 2인 경우, I6의 값을 B열에 복사
                ws.Cells(i, "B").Value = valueToCopy
                ' 해당 행을 새 워크북에 복사
                ws.Rows(i).Copy Destination:=newWs.Cells(nextRow, 1)
                nextRow = nextRow + 1 ' 다음 행으로 이동
            End If
        Next i

        ' 각 파일 데이터 사이에 한 줄 띄우기
        nextRow = nextRow + 1

        ' 원본 워크북 닫기 (변경사항 저장하지 않음)
        wb.Close SaveChanges:=False

        myFile = Dir
    Loop

    ' 새 워크북의 첫 번째 시트 이름 변경
    newWb.Sheets(1).Name = "MergedData"
End Sub

 

 

저는 일을 수월하기 위해 K열이 2인경우(F,G열에 숫자가 들어가있으면 K를 2로 표기하게 했습니다.)

K열이 2인경우 B열에 날자I6을 가져오고, K2인것만 복사해서 한시트에 가져오기였습니다.

이는 해당사항이 없으면 편집해서 쓰십쇼 ㅎㅎ