Hỏi cách gộp các file excel từ nhiều Sheet khác nhau vào 1 Sheet

Liên hệ QC
U

uronmapu

Thành viên thường trực
Tham gia
9/6/10
Bài viết
351
Được thích
13
Xin chào các Thầy,

Em có 1 workbook với 8 sheets khác nhau (từ Sheet1, ... Sheet8)

8 Sheets này có các cột giống nhau nhưng khác giá trị trong các dòng

Em tạo 1 sheet 9

E muốn sheet 9 này sẽ lần lượt chứa các giá trị (các dòng) của lần lượt 8 sheets kia

Nếu em nhập thêm giá trị vào dòng của sheet1, ..., sheet8 thì trong sheet9 tự động chèn vào

Em gửi file đính kèm ạ

Xin các Thầy giúp em cách làm ạ

Em cảm ơn
 

File đính kèm

  • GopNhieuSheet.xlsx
    29 KB · Đọc: 411
Lần chỉnh sửa cuối:
uronmapu đã viết:
Xin chào các Thầy,

Em có 1 workbook với 8 sheets khác nhau (từ Sheet1, ... Sheet8)

8 Sheets này có các cột giống nhau nhưng khác giá trị trong các dòng

Em tạo 1 sheet 9

E muốn sheet 9 này sẽ lần lượt chứa các giá trị (các dòng) của lần lượt 8 sheets kia

Nếu em nhập thêm giá trị vào dòng của sheet1, ..., sheet8 thì trong sheet9 tự động chèn vào

Xin các Thầy giúp em cách làm ạ

Em cảm ơn
Nhấp chuột vào đây để mở rộng...

Bạn tham gia diễn đàn cũng được 1 thời gian rồi, --> mấy cái vụ chắc bạn cũng biết là nên có file đính kèm,mới dễ giải quyết ???

Còn giải pháp thì có nhiều :
* Dùng marco : dùng recrod macro ghi lại quá trình bạn thao tác bằng tay --> có code tức thì :-=
 
hungpecc1 đã viết:
Bạn tham gia diễn đàn cũng được 1 thời gian rồi, --> mấy cái vụ chắc bạn cũng biết là nên có file đính kèm,mới dễ giải quyết ???

Còn giải pháp thì có nhiều :
* Dùng marco : dùng recrod macro ghi lại quá trình bạn thao tác bằng tay --> có code tức thì :-=
Nhấp chuột vào đây để mở rộng...

Em attach lại file rồi ạ, các bác giúp em với ạ
Em cảm ơn
 

File đính kèm

  • GopNhieuSheet.xlsm
    26.2 KB · Đọc: 1,553
Cảm ơn bác, bác dùng Macro ạ, có cách nào vẫn giữ nguyên tên file là .xlsx không bác ?

Sub NMH()
Dim cnn As New ADODB.Connection, rst As New ADODB.Recordset
Dim SQL$, ws As Worksheet
With cnn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data source=" & ThisWorkbook.FullName & _
";Extended properties=""Excel 12.0;IMEX=1;HDR=Yes"";"
.Open
End With
For Each ws In Worksheets
If ws.CodeName <> "THOP" Then SQL = SQL & " " & "[" & ws.Name & "$A:G]"
Next
SQL = "SELECT * FROM " & Replace(Trim(SQL), " ", " UNION ALL SELECT * FROM ")
rst.Open SQL, cnn, 3, 3, 1
[A2].CopyFromRecordset rst
rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing
End Sub
 
uronmapu đã viết:
Cảm ơn bác, bác dùng Macro ạ, có cách nào vẫn giữ nguyên tên file là .xlsx không bác ?
[GPECODE=vb]
Sub NMH()
Dim cnn As New ADODB.Connection, rst As New ADODB.Recordset
Dim SQL$, ws As Worksheet
With cnn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data source=" & ThisWorkbook.FullName & _
";Extended properties=""Excel 12.0;IMEX=1;HDR=Yes"";"
.Open
End With
For Each ws In Worksheets
If ws.CodeName <> "THOP" Then SQL = SQL & " " & "[" & ws.Name & "$A:G]"
Next
SQL = "SELECT * FROM " & Replace(Trim(SQL), " ", " UNION ALL SELECT * FROM ")
rst.Open SQL, cnn, 3, 3, 1
[A2].CopyFromRecordset rst
rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing
End Sub
[/GPECODE]
Nhấp chuột vào đây để mở rộng...

định dạng xlsx không có code vba trong file --> muốn vẫn lưu được dưới dạng xlsx và "tự động copy" theo cách của bạn --> mình nghĩ chỉ có lưu 1 file có code duới dạng xlam ( hay là tạo 1 nút trên menu bar)
 
Lần chỉnh sửa cuối:
Nếu như các cột trong các sheet em thay tên khác và bổ sung thêm cột nữa thì thế nào bác?
 
uronmapu đã viết:
Nếu như các cột trong các sheet em thay tên khác và bổ sung thêm cột nữa thì thế nào bác?
Nhấp chuột vào đây để mở rộng...
Thử với Sub này coi sao.
Yêu cầu tiêu đề ở dòng 1 giống nhau ở tất cả các sheet
Dữ liệu bắt đầu từ dòng 2 trở xuống.
Sheet gộp các sheet phải đặt tên sheet là "GPE"
PHP: 
Public Sub GPE()
Dim sArr(), dArr(1 To 65000, 1 To 250), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "GPE" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65000].End(xlUp)).Resize(, Ws.[IV1].End(xlToLeft).Column)
        If Ws.[IV1].End(xlToLeft).Column > Col Then Col = Ws.[IV1].End(xlToLeft).Column
        For I = 1 To UBound(sArr, 1)
            K = K + 1
            For J = 1 To UBound(sArr, 2)
                dArr(K, J) = sArr(I, J)
            Next J
        Next I
    End If
Next
With Sheets("GPE")
    .[A4:IV65000].ClearContents
    If K Then .[A4].Resize(K, Col).Value = dArr
End With
End Sub
 
Lần chỉnh sửa cuối:
Ba Tê đã viết:
Thử với Sub này coi sao.
Yêu cầu tiêu đề ở dòng 1 giống nhau ở tất cả các sheet
Dữ liệu bắt đầu từ dòng 2 trở xuống.
Sheet gộp các sheet phải đặt tên sheet là "GPE"
PHP: 
Public Sub GPE()
Dim sArr(), dArr(1 To 65000, 1 To 250), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "GPE" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65000].End(xlUp)).Resize(, Ws.[IV1].End(xlToLeft).Column)
        If Ws.[IV1].End(xlToLeft).Column > Col Then Col = Ws.[IV1].End(xlToLeft).Column
        For I = 1 To UBound(sArr, 1)
            K = K + 1
            For J = 1 To UBound(sArr, 2)
                dArr(K, J) = sArr(I, J)
            Next J
        Next I
    End If
Next
With Sheets("GPE")
    .[A4:IV65000].ClearContents
    If K Then .[A4].Resize(K, Col).Value = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...

Cái này của bác cột Ngày phải nhập nó mới chạy, mà mỗi lần nhập Sheet1 chẳng hạn thì Sheet GPE không tự cập nhật
Phải chạy Run Macro thủ công mới thấy
 
uronmapu đã viết:
Cái này của bác cột Ngày phải nhập nó mới chạy, mà mỗi lần nhập Sheet1 chẳng hạn thì Sheet GPE không tự cập nhật
Phải chạy Run Macro thủ công mới thấy
Nhấp chuột vào đây để mở rộng...
Vụ gì vậy , code này chỉ là code chính, là giải thuật ,--> nếu bạn muốn tự động thì phải viết thêm sự kiện trong sheet GPE ( worksheet_active ) nữa!
 
hungpecc1 đã viết:
Vụ gì vậy , code này chỉ là code chính, là giải thuật ,--> nếu bạn muốn tự động thì phải viết thêm sự kiện trong sheet GPE ( worksheet_active ) nữa!
Nhấp chuột vào đây để mở rộng...

Vâng, em làm thêm sự kiện bên dưới rồi ạ, có điều nếu mà cột ngày khi nhập mới thêm vào mà ko nhập (các cột khác nhập) thì trong Sheet GPE không hiển thị. Thêm nữa bị cách 2 dòng trắng (2 và 3) - (sưa A4 thành A2 là được)

Private Sub Worksheet_Activate()
[A2:G10000].ClearContents
Module1.GPE
MsgBox " DA TONG HOP VA CAP NHAP DU LIEU "
End Sub
 

File đính kèm

  • GopNhieuSheet_GPE.xlsm
    26.4 KB · Đọc: 198
Lần chỉnh sửa cuối:
uronmapu đã viết:
Vâng, em làm thêm sự kiện bên dưới rồi ạ, có điều nếu mà cột ngày khi nhập mới thêm vào mà ko nhập (các cột khác nhập) thì trong Sheet GPE không hiển thị. Thêm nữa bị cách 2 dòng trắng (2 và 3) - (sưa A4 thành A2 là được)

Private Sub Worksheet_Activate()
[A2:G10000].ClearContents
Module1.GPE
MsgBox " DA TONG HOP VA CAP NHAP DU LIEU "
End Sub
Nhấp chuột vào đây để mở rộng...
Hơi bị oải kiểu "phát biểu này" quá.
Từ đầu đâu có nói là cột nào sẽ có, cột nào sẽ không có dữ liệu, ai mà đoán trước hết các tính huống "NẾU MÀ" của bạn được.
Thử lại cái này xem.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(1 To 1000, 1 To 100), I As Long, J As Long, K As Long, Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "GPE" Then
        sArr = Ws.[A1].CurrentRegion.Offset(1).Value
        For I = 1 To UBound(sArr, 1) - 1
            K = K + 1
            For J = 1 To UBound(sArr, 2)
                dArr(K, J) = sArr(I, J)
            Next J
        Next I
    End If
Next
With Sheets("GPE")
    .[A2:Z1000].ClearContents
    If K Then .[A2].Resize(K, .[IV1].End(xlToLeft).Column).Value = dArr
End With
End Sub
 
Em cảm ơn bác nhiều!
 
Bác ơi cho em hỏi thêm, Nếu dữ liệu của em bắt đầu từ dòng số 4 (hoặc số 5) từ dòng 3 (dòng 4) trở lên em ghi đề mục

Thì câi lênh em sửa ở chỗ nào ạ
 
uronmapu đã viết:
Bác ơi cho em hỏi thêm, Nếu dữ liệu của em bắt đầu từ dòng số 4 (hoặc số 5) từ dòng 3 (dòng 4) trở lên em ghi đề mục

Thì câi lênh em sửa ở chỗ nào ạ
Nhấp chuột vào đây để mở rộng...
Thì bạn cứ tự chỉnh lại vì người giúp bạn chỉ làm theo file của bạn thôi.
Khi mình gởi file nhờ người khác giúp thì cũng phải "tự hiểu" dữ liệu thật của mình ra sao chứ.
Tôi "chạy" topic này.
 
Híc, bác Ba Tê
user-offline.png
khó tính quá, em cũng đã nghiên cứu thử mò mẫm nhưng ko được :(
 

File đính kèm

  • GopNhieuSheet_GPE.xlsm
    26.2 KB · Đọc: 313
Lần chỉnh sửa cuối:
Ba Tê đã viết:
Hơi bị oải kiểu "phát biểu này" quá.
Từ đầu đâu có nói là cột nào sẽ có, cột nào sẽ không có dữ liệu, ai mà đoán trước hết các tính huống "NẾU MÀ" của bạn được.
Thử lại cái này xem.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(1 To 1000, 1 To 100), I As Long, J As Long, K As Long, Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "GPE" Then
        sArr = Ws.[A1].CurrentRegion.Offset(1).Value
        For I = 1 To UBound(sArr, 1) - 1
            K = K + 1
            For J = 1 To UBound(sArr, 2)
                dArr(K, J) = sArr(I, J)
            Next J
        Next I
    End If
Next
With Sheets("GPE")
    .[A2:Z1000].ClearContents
    If K Then .[A2].Resize(K, .[IV1].End(xlToLeft).Column).Value = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...

Trường hợp này sửa thành lệnh bên dưới với dữ liệu từ dòng 5

Public Sub GPE()
Dim sArr(), dArr(1 To 1000, 1 To 100), I As Long, J As Long, K As Long, Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "GPE" Then
sArr = Ws.[A5].CurrentRegion.Offset(1).Value
For I = 4 To UBound(sArr, 1) - 1
K = K + 1
For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
Next I
End If
Next
With Sheets("GPE")
.[A5:Z1000].ClearContents
If K Then .[A5].Resize(K, .[IV1].End(xlToLeft).Column).Value = dArr
End With
End Sub
 

File đính kèm

  • GopNhieuSheet_GPE_BATE.xlsm
    26.2 KB · Đọc: 245
Lần chỉnh sửa cuối:
Ba Tê đã viết:
Thì bạn cứ tự chỉnh lại vì người giúp bạn chỉ làm theo file của bạn thôi.
Khi mình gởi file nhờ người khác giúp thì cũng phải "tự hiểu" dữ liệu thật của mình ra sao chứ.
Tôi "chạy" topic này.
Nhấp chuột vào đây để mở rộng...

Dân hỏi ở đây vốn tật lười suy nghĩ về vấn đề của mình lắm.
Trên 90% các trường hợp là họ không biết mình cần phải làm gì. Họ chỉ biết loáng thoáng. Đến chừng thấy giải đáp bước 1 rồi mới nhận ra bước 2. Đến chừng giải đấp ổn thoả rồi mới thấy lòi ra mấy trường hợp ngoại lệ.

Người giải đáp không phải chỉ cởi trói một gút mắc nào đó, mà hầu hết là phải dẫn dắt từ A đến Z.
 
VetMini đã viết:
Dân hỏi ở đây vốn tật lười suy nghĩ về vấn đề của mình lắm.
Trên 90% các trường hợp là họ không biết mình cần phải làm gì. Họ chỉ biết loáng thoáng. Đến chừng thấy giải đáp bước 1 rồi mới nhận ra bước 2. Đến chừng giải đấp ổn thoả rồi mới thấy lòi ra mấy trường hợp ngoại lệ.

Người giải đáp không phải chỉ cởi trói một gút mắc nào đó, mà hầu hết là phải dẫn dắt từ A đến Z.
Nhấp chuột vào đây để mở rộng...

Bởi vậy dân hỏi với lên GPE để mong các Thầy giúp đỡ
Không phải tất cả trường hợp do bồng phát đến bước 2, có thể dân hỏi đã đáp ứng được nhưng họ vẫn muốn mở rộng bài toán ra rộng hơn. Để những dân hỏi đời F1 không phải đào mộ topic nữa. Chứng tỏ dân hỏi rất có suy nghĩ
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
16
Đọc
419
ongke0711
ongke0711
LuuGiaPhúc
Tìm công thức mảng tính giá trị lớn nhất theo từng hàng
Trả lời
7
Đọc
97
huuthang_bd
huuthang_bd
H
Cần giúp tìm kiếm SQL từ VBA với điều kiện Tiếng Việt
Trả lời
0
Đọc
32
Haidang7979
H
maytinhvp01
  • Question
Chuyên đề giải đáp những thắc mắc về code VBA
    • Thích
151 152 153
Trả lời
3K
Đọc
276K
hongquan93vn
hongquan93vn
noisy
Nhờ hỗ trợ tạo thống kê
Trả lời
0
Đọc
30
noisy
noisy
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom