Sao chép CurrentRegion của một ô trong mỗi trang tính thành một trang tính bằng VBA trong Microsoft Excel
Nếu bạn đang xử lý nhiều trang tính cùng một lúc và bạn muốn sao chép dữ liệu từ mỗi trang tính vào một trang tính chính thì bạn nên đọc bài viết này. Chúng tôi sẽ sử dụng thuộc tính khu vực hiện tại của mã VBA để hợp nhất dữ liệu từ tất cả các trang tính thành một trang tính duy nhất. Thuộc tính này hữu ích cho nhiều hoạt động tự động mở rộng vùng chọn để bao gồm toàn bộ vùng hiện tại, chẳng hạn như phương pháp Tự động định dạng. Thuộc tính này không thể được sử dụng trên một trang tính được bảo vệ.
Điều kiện là: mọi trang tính phải có định dạng tương tự, tức là cùng một số cột; sử dụng cùng một định dạng, chúng tôi có thể có dữ liệu được hợp nhất chính xác.
Xin lưu ý: bài viết này sẽ chứng minh bằng cách sử dụng mã VBA; nếu vì bất kỳ lý do gì mà số lượng cột khác nhau trong một trong các trang tính thì toàn bộ dữ liệu đã hợp nhất sẽ không cho hình ảnh chính xác. Chúng tôi rất khuyến khích sử dụng cùng một số cột. Mã VBA sẽ thêm một trang tính mới vào sổ làm việc, sau đó sao chép và dán dữ liệu sau mỗi trang tính mà không ghi đè.
Chúng ta hãy lấy ví dụ về 3 trang tính, đó là tháng 1, tháng 2 và tháng 3. Sau đây là ảnh chụp nhanh của các trang này:
Để kết hợp dữ liệu từ tất cả các trang tính thành một trang tính, chúng ta cần làm theo các bước sau để khởi chạy trình soạn thảo VB:
Nhấp vào tab Nhà phát triển Từ nhóm Mã chọn Visual Basic
-
Sao chép đoạn mã dưới đây trong mô-đun chuẩn
Sub CopyCurrentRegion()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
sh.Range("A1").CurrentRegion.Copy DestSh.Cells(Last + 1, 1)
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Sub CopyCurrentRegionValues()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exist"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
With sh.Range("A1").CurrentRegion
DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _
.Columns.Count).Value = .Value
End With
End If
End If
Next
Application.ScreenUpdating = True
End Sub
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
Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(Sheets(SName).Name))
End Function
Nếu bạn thích blog của chúng tôi, hãy chia sẻ nó với bạn bè của bạn trên Facebook. Và bạn cũng có thể theo dõi chúng tôi trên Twitter và Facebook.
Chúng tôi rất muốn nghe ý kiến từ bạn, hãy cho chúng tôi biết cách chúng tôi có thể cải thiện, bổ sung hoặc đổi mới công việc của mình và làm cho nó tốt hơn cho bạn. Viết thư cho chúng tôi tại [email protected]