Sub 화일열지않고모으기()
Dim varFileName As Variant
Dim varTemp As Variant
Dim shtSheet As Worksheet
Dim wrkBook As Workbook
Dim rngCell As Range
Dim i As Integer
Dim rngTarget As Range
Application.ScreenUpdating = False
varFileName = Application.GetOpenFilename(filefilter:="Excel Files(*.xls),*.xls", _
Title:="일자별 문서를 모두 선택하세요", MultiSelect:=True)
If TypeName(varFileName) = "Boolean" Then Exit Sub
Set shtSheet = Worksheets.Add
shtSheet.Move after:=Sheets(Sheets.Count)
For Each varTemp In varFileName
Set wrkBook = Workbooks.Open(varTemp)
Set rngTarget = shtSheet.Cells(65536, 1).End(xlUp).Offset(1, 0)
wrkBook.Worksheets(1).UsedRange.Offset(0, 0).Copy rngTarget
Application.CutCopyMode = False
wrkBook.Close savechanges:=False
i = i + 1
Next varTemp
If i = 0 Then
MsgBox "오류가 발생하였습니다"
GoTo ET
End If
Application.ScreenUpdating = True
MsgBox "일자별 자료를 새로운 시트에 모두 복사하였습니다", _
Title:="복사완료"
ET:
End Sub
excel_tip.zip
이올린에 북마크하기
댓글을 달아 주세요