Nối nhiều sheet thành một sheet

Nếu như bạn muốn nối nhiều sheet lại thành một sheet duy nhất , cách thức tiến hành như sau .

1. Mở File Excel , bấm Alt_F11 .

2. Cửa sổ Microsoft Visual Basic mở ra , bấm menu Insert > Module .

Dán những nội dung dưới đây
Option Explicit
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
On Error GoTo 0
End Function
Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
On Error GoTo 0
End Function
Sub CopyTheUsedRangeOfEachSheet()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Summary").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "Summary"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
Last = LastRow(DestSh)
sh.UsedRange.Copy DestSh.Cells(Last + 1, "A")
'Instead of this line you can use the code below to copy only the values
'or use the PasteSpecial option to paste the format also.
'With sh.UsedRange
'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
'.Columns.Count).Value = .Value
'End With
'sh.UsedRange.Copy
'With DestSh.Cells(Last + 1, "A")
' .PasteSpecial xlPasteValues, , False, False
' .PasteSpecial xlPasteFormats, , False, False
' Application.CutCopyMode = False
'End With
End If
Next
DestSh.Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Summary already exist"
End If
End Sub

Hoặc

Sub MergeSheets()
Const NHR = 1
Dim MWS As Worksheet
Dim AWS As Worksheet
Dim FAR As Long
Dim LR As Long
Set AWS = ActiveSheet
For Each MWS In ActiveWindow.SelectedSheets
If Not MWS Is AWS Then
FAR = AWS.UsedRange.Cells(AWS.UsedRange.Cells.Count).Row + 1
LR = MWS.UsedRange.Cells(MWS.UsedRange.Cells.Count).Row
MWS.Range(MWS.Rows(NHR + 1), MWS.Rows(LR)).Copy AWS.Rows(FAR)
End If
Next MWS
End Sub

3. Quay trở lại Excel, đánh dấu chọn những sheet mà bạn muốn nối lại.

4. Bấm menu Tool > Macro > Macro , bạn sẽ chọn CopyTheUsedRangeOfEachSheet (nếu bạn sử dụng đoạn code 1) hoặc MergeSheets (nếu bạn sử dụng đoạn code 2) và bấm Run

Nguồn: Sưu tầm 

Các bài liên quan

Đổi tên các tập tin bằng macro
Tạo danh sách tên tập tinh bằng lệnh MS-Dos
Nhân bản trang tính
Giới thiệu về Macro
Forms ComboBox
ActiveX ComBoBox
Định dạng tên la tinh

Tạo mục lục tự động trong Excel
Nối nhiều File Excel thành một
Cách hiện tất cả trang tính đã ẩn
Tạo công thức đọc số tiền thành chữ