[VBA] 시트 합치기
어찌저찌 만들었는데 제목행 시트 처리 문제가 있다.
- 첫번째 시트에 제목행을 입력하면 새시트 만들때 제목행이 입력되고
- 취합 시트를 제목행 부터 복사 하게 만들고 싶다
그런데 그게 안된다
코드 참고
시트생성 및 중복확인
www.officetutor.co.kr/board/Dtype/bfrmvw.asp?f_tn=Dqa_excel_n2&f_bno=64613&page=7&fchk=&fval
데이터 취합
여러 개 파일 한 시트에 취합하는 엑셀 VBA 프로그램[엑셀 교육_김경자 강사]
엑셀에서 같은 양식의 데이터가 여러 파일에 분리되어 있는 것을 하나의 시트에 모으는 작업을 자주 하게 ...
blog.naver.com
Sub allsumsheets()
Dim i As Integer
For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Name = ActiveWorkbook.Sheets("합치기").Cells(3, 2).Value Then
Call sumsheets
Exit Sub
End If
Next
Call CreateNewSheet
End Sub
Sub sumsheets()
Dim fileNo As Variant
Dim i As Integer
Dim ingFile As Workbook
Dim SumSheet As Worksheet
Dim iRow As Integer
Set SumSheet = ThisWorkbook.Worksheets(Sheets("합치기").Cells(3, 2).Value)
On Error GoTo 에러처리
fileNo = Application.GetOpenFilename(Filefilter:="엑셀파일(*.xlsx*),*.xlsx*", MultiSelect:=True)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 1 To UBound(fileNo)
Set ingFile = Workbooks.Open(Filename:=fileNo(i), ReadOnly:=True)
iRow = SumSheet.Range("A3").CurrentRegion.Rows.Count + 2
With ingFile.Sheets(1)
.Range(.Range("A2").End(xlDown), .Range("A2").End(xlToRight)).Copy
End With
SumSheet.Cells(iRow, 1).PasteSpecial
ingFile.Close
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "파일 취합이 완료되었습니다"
Exit Sub
에러처리:
MsgBox "파일을 선택하지 않았습니다"
End Sub
Sub CreateNewSheet()
If ActiveWorkbook.Sheets("합치기").Cells(3, 2).Value = "" Then
MsgBox ("에러: B3셀을 입력하세요")
Exit Sub
Else
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
For Each ws In Sheets
lw = ws.Name
Next
Worksheets(lw).Name = ActiveWorkbook.Sheets("합치기").Cells(3, 2).Value
Call sumsheets
End If
End Sub