Trong bài viết này, chúng tôi sẽ tạo một macro để sao chép dữ liệu từ tất cả các trang tính trong sổ làm việc sang một trang tính mới.

Dữ liệu thô cho ví dụ này bao gồm thông tin chi tiết về nhân viên từ các phòng ban khác nhau trong các trang tính khác nhau. Chúng tôi muốn hợp nhất thông tin chi tiết của nhân viên thành một trang duy nhất.

ArrowRawData

Chúng tôi đã tạo macro “CopyRangeFromMultipleSheets” để hợp nhất dữ liệu. Có thể chạy macro này bằng cách nhấp vào nút “Hợp nhất dữ liệu”.

ArrowMain

Macro sẽ tạo một trang tính mới và chèn dữ liệu tổng hợp từ tất cả các trang tính.

ArrowOutput

Giải thích mã

‘Vòng lặp’ qua tất cả các trang tính để kiểm tra xem trang tính “Chính” có tồn tại hay không.

Đối với mỗi nguồn trong ThisWorkbook.Worksheets Nếu Source.Name = “Master” thì MsgBox “Master sheet đã tồn tại”

Thoát Kết thúc Phụ Nếu Tiếp theo Mã trên được sử dụng để kiểm tra xem trang tính “Chính” có tồn tại trong sổ làm việc hay không. Nếu trang tính “Chính” tồn tại trong sổ làm việc, thì mã sẽ thoát và thông báo lỗi được hiển thị.

Source.Range (“A1”). SpecialCells (xlLastCell) .Row Trên mã được sử dụng để lấy số hàng của ô cuối cùng trong trang tính.

Source.Range (“A1”, Range (“A1”). SpecialCells (xlLastCell)). Sao chép Destination.Range (“A” & DestLastRow)

Đoạn mã trên được sử dụng để sao chép phạm vi được chỉ định vào ô đã xác định.

Vui lòng theo dõi bên dưới để biết mã

Sub CopyRangeFromMultipleSheets()

'Declaring variables

Dim Source As Worksheet

Dim Destination As Worksheet

Dim SourceLastRow, DestLastRow As Long

Application.ScreenUpdating = False

'Looping through all sheets to check whether "Master" sheet exist

For Each Source In ThisWorkbook.Worksheets

If Source.Name = "Master" Then

MsgBox "Master sheet already exist"

Exit Sub

End If

Next

'Inserting a new sheet after the "Main" sheet

Set Destination = Worksheets.Add(after:=Sheets("Main"))

Destination.Name = "Master"

'Looping through all the sheets in the workbook

For Each Source In ThisWorkbook.Worksheets



'Preventing consolidation of data from "Main" and "Master" sheet

If Source.Name <> "Main" And Source.Name <> "Master" Then



SourceLastRow = Source.Range("A1").SpecialCells(xlLastCell).Row



Source.Activate



If Source.UsedRange.Count > 1 Then



DestLastRow = Sheets("Master").Range("A1").SpecialCells(xlLastCell).Row



If DestLastRow = 1 Then

'copying data from the source sheet to destination sheet

Source.Range("A1", Range("A1").SpecialCells(xlLastCell)).Copy Destination.Range("A" & DestLastRow)

Else

Source.Range("A2", Range("A1").SpecialCells(xlCellTypeLastCell)).Copy Destination.Range("A" & (DestLastRow + 1))

End If



End If

End If

Next

Destination.Activate

Application.ScreenUpdating = True

End Sub

Nếu bạn thích blog này, hãy chia sẻ nó với bạn bè của bạn trên Facebook 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 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 [email protected]