vba 여러 Excel 문서 병합
1498 단어 ExcelVba
vba 여러 Excel 문서 병합
참조:https://blog.csdn.net/win_turn/article/details/75577465
설명: 주소를 인용한 토대에서 수정을 하여 회사 사용자의 수요에 따라 sheet 페이지와 excel 문서를 합쳤다.
모든sheet에만 적용되는 첫 번째 줄은 데이터 헤더이고 데이터는 두 번째 줄부터 시작합니다.
코드:Sub ()
Dim FileOpen
Dim X As Integer
Application.ScreenUpdating = False
Rem
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel (*.xlsx),*.xlsx,
Excel 97-2003 (*.xls),*xls", MultiSelect:=True, Title:=" ")
X = 1
If TypeName(FileOpen) = "Boolean" Then
MsgBox " , ."
Exit Sub
End If
While X <= UBound(FileOpen)
Workbooks.Open Filename:=FileOpen(X)
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
X = X + 1
Wend
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Sheets(1).Name = " "
Sheets(2).Activate
Sheets(2).Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
c = Sheets(J).Range("IV1").End(xlToLeft).Column
r = Sheets(J).Range("A65536").End(xlUp).Row
Sheets(J).Range("A2").Resize(r - 1, c).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
errhadler:
MsgBox Err.Description
End Sub
Sub ()
Dim FileOpen
Dim X As Integer
Application.ScreenUpdating = False
Rem
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel (*.xlsx),*.xlsx,
Excel 97-2003 (*.xls),*xls", MultiSelect:=True, Title:=" ")
X = 1
If TypeName(FileOpen) = "Boolean" Then
MsgBox " , ."
Exit Sub
End If
While X <= UBound(FileOpen)
Workbooks.Open Filename:=FileOpen(X)
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
X = X + 1
Wend
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Sheets(1).Name = " "
Sheets(2).Activate
Sheets(2).Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
c = Sheets(J).Range("IV1").End(xlToLeft).Column
r = Sheets(J).Range("A65536").End(xlUp).Row
Sheets(J).Range("A2").Resize(r - 1, c).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
errhadler:
MsgBox Err.Description
End Sub