Hỏi cách gộp các file excel từ nhiều Sheet khác nhau vào 1 Sheet (1 người xem)

  • Thread starter Thread starter uronmapu
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
U

uronmapu

Thành viên thường trực
Tham gia
9/6/10
Bài viết
361
Được thích
15
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

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

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

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

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

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ĩ
 
xin chao cac ban! cac ban cho tui hoi tý
các ban gộp sheet thực hiên excel 2007 hay 2003??????????hĩ. sao tui thực hien tren 2007 lai ko dc. ai lam 2007 oy giup tui voi. tui mo excel chứa các sheet muốn gộp mà khi ấn alt-f11 lai ko ra gi ka.
 
Chao moi nguoi minh la thanh vien moi . mình muon gop cac sheet trong file kem thanh 1 sheet tong hop ( tieu đe tu dong A1 den dong A3 van giu , va dong cuoi cung ngay thang nam va nguoi lap bang van giu ) . khi minh chinh sua 1 trong cac sheet thi sheet tong hop se tu dong cap nhat . Ai giup minh voi
 

File đính kèm

Xin chào các anh chị diễn đàn.
Em có 1 file dữ liệu cho từng này và muốn tổng hợp dữ liệu vào sheet "Summary".
Em có thử dử dụng cách bên trên nhưng không hiệu quả đối với file này, nhờ các anh chị cho em lời khuyên.

File của em muốn lấy dữ liệu từ ô E6 (cột số PO) tới hết dữ liệu cuối cùng của cột R (Thòi gian (phút)).
Sau đó dán vào sheet "Summary" từ cột D.

Nhờ các anh chị giúp đỡ (xin lỗi vì file em hơi nặng).
Em cám ơn.
 

File đính kèm

Nhatnguyen1624 đã viết:
Xin chào các anh chị diễn đàn.
Em có 1 file dữ liệu cho từng này và muốn tổng hợp dữ liệu vào sheet "Summary".
Em có thử dử dụng cách bên trên nhưng không hiệu quả đối với file này, nhờ các anh chị cho em lời khuyên.

File của em muốn lấy dữ liệu từ ô E6 (cột số PO) tới hết dữ liệu cuối cùng của cột R (Thòi gian (phút)).
Sau đó dán vào sheet "Summary" từ cột D.

Nhờ các anh chị giúp đỡ (xin lỗi vì file em hơi nặng).
Em cám ơn.
Nhấp chuột vào đây để mở rộng...
Dùng code sau nhé:

Mã: 
Sub LayDL_HLMT()
    Dim cn As Object
    Dim strField, strSQL As String
    Dim i  As Integer
    Set cn = CreateObject("ADODB.Connection")
    For i = 1 To 14
        strField = strField & "," & IIf(i > 1, " val(F" & i & ")", "F1")
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 31
        strSQL = strSQL & " union all select " & strField & " from [" & Format(i, "00$") & "E6:R] where F1 is not null"
        
    Next
    strSQL = Right(strSQL, Len(strSQL) - 10)
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
    Sheet33.Range("D6").CopyFromRecordset cn.Execute(strSQL)
  
End Sub
 
Hai Lúa Miền Tây đã viết:
Dùng code sau nhé:

Mã: 
Sub LayDL_HLMT()
    Dim cn As Object
    Dim strField, strSQL As String
    Dim i  As Integer
    Set cn = CreateObject("ADODB.Connection")
    For i = 1 To 14
        strField = strField & "," & IIf(i > 1, " val(F" & i & ")", "F1")
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 31
        strSQL = strSQL & " union all select " & strField & " from [" & Format(i, "00$") & "E6:R] where F1 is not null"
       
    Next
    strSQL = Right(strSQL, Len(strSQL) - 10)
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
    Sheet33.Range("D6").CopyFromRecordset cn.Execute(strSQL)
 
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ em xin cám ơn rất nhiều.
 
chào các bác. Trong file của em muốn gộp các sheet vào sheet (GOP) trong đó giá trị lấy từ cột A3 của các sheet đến hết đặt vào cột B của sheet (GOP). Cột A của sheet (GOP) là để giá trị tên của các sheet mình lấy giá trị. Các bác hướng dẫn em cách làm với ạ. Em cảm ơn.
 

File đính kèm

các tiền bối giúp em với. :(((((((
 
quocphu67 đã viết:
chào các bác. Trong file của em muốn gộp các sheet vào sheet (GOP) trong đó giá trị lấy từ cột A3 của các sheet đến hết đặt vào cột B của sheet (GOP). Cột A của sheet (GOP) là để giá trị tên của các sheet mình lấy giá trị. Các bác hướng dẫn em cách làm với ạ. Em cảm ơn.
Nhấp chuột vào đây để mở rộng...
Như thế này hả bạn?
 

File đính kèm

Mình cũng có vấn đề tương tự. Giả sử mình có file đính kèm đây, trong đó sheet 1 và sheet 2 là dữ liệu khác nhau, nhưng cùng tên cột. Giờ mình muốn tổng hợp 2 sheet trên vào sheet 3 (gọi là sheet tổng hợp), trong đó lần lượt là thông tin của sheet 1 rồi đến sheet 2. Mình muốn sau này nếu có thay đổi thông tin trên sheet 1 hay sheet 2 thì thông tin trên sheet 3 tự động thay đổi. Hoặc nếu sheet 1 hoặc 2 thêm/bớt dòng thì việc đó cũng được tự động thay đổi ở sheet tổng hợp. Mình biết các bạn ở trên dùng code. Tuy nhiên, nếu dùng code, khi mở file, thường có thông báo macro. Liệu có cách nào không dùng code mà vẫn xử lý được các tình huống trên không, vì bên mình mọi người hay lo ngại khi thấy macro. Xin các bạn chỉ giáo. Mình cám ơn rất nhiều.
 

File đính kèm

Hi mọi người,

Em có dùng code của anh Hai lúa miền tây.
Em có thay đổi 1 chút để phù hợp với file của em, nhưng mà nó báo lỗi. Em lại k rành cái này lắm.
Kính mong mọi người giúp đỡ.
Tiện thể giúp em, ở mỗi sheet em lấy thêm dữ liệu ở B7 và I7 với ạ.
Cám ơn mọi người
 

File đính kèm

mshuyenvn đã viết:
Hi mọi người,

Em có dùng code của anh Hai lúa miền tây.
Em có thay đổi 1 chút để phù hợp với file của em, nhưng mà nó báo lỗi. Em lại k rành cái này lắm.
Kính mong mọi người giúp đỡ.
Tiện thể giúp em, ở mỗi sheet em lấy thêm dữ liệu ở B7 và I7 với ạ.
Cám ơn mọi người
Nhấp chuột vào đây để mở rộng...
Bạn thử chỉnh code lại như sau nhé.

Mã: 
Sub LayDL_HLMT()
    Dim strField, strSQL As String
    Dim i  As Integer
    For i = 1 To 11
        strField = strField & "," & "F" & i
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 26
        strSQL = strSQL & " union all select " & strField & " from [" & i & "$a18:k] where F9 is not null"
    Next
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
        Sheet15.Range("a3").CopyFromRecordset .Execute(Right(strSQL, Len(strSQL) - 10))
    End With
End Sub
 
Hai Lúa Miền Tây đã viết:
Bạn thử chỉnh code lại như sau nhé.

Mã: 
Sub LayDL_HLMT()
    Dim strField, strSQL As String
    Dim i  As Integer
    For i = 1 To 11
        strField = strField & "," & "F" & i
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 26
        strSQL = strSQL & " union all select " & strField & " from [" & i & "$a18:k] where F9 is not null"
    Next
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"";"
        Sheet15.Range("a3").CopyFromRecordset .Execute(Right(strSQL, Len(strSQL) - 10))
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em có cho chạy thử, nhưng dữ liệu cột B chỗ có chỗ k và nó chỉ lấy đc 1 vài sheet thôi ạ
 
Em hiểu nhầm ý.
Đúng là cái file em gửi lên đấy ạ.
 
Lần chỉnh sửa cuối:
mshuyenvn đã viết:
Em hiểu nhầm ý.
Đúng là cái file em gửi lên đấy ạ.
Nhấp chuột vào đây để mở rộng...
Tôi chỉnh lại như sau:

Mã: 
Sub LayDL_HLMT()
    Dim strField, strSQL As String
    Dim i  As Integer
    For i = 1 To 11
        strField = strField & "," & "F" & i
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 26
        strSQL = strSQL & " union all select " & strField & " from [" & i & "$a18:k] where F5 is not null and F7>0"
    Next
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
        Sheet14.Range("a3").CopyFromRecordset .Execute(Right(strSQL, Len(strSQL) - 10))
    End With
End Sub
 
Hai Lúa Miền Tây đã viết:
Tôi chỉnh lại như sau:

Mã: 
Sub LayDL_HLMT()
    Dim strField, strSQL As String
    Dim i  As Integer
    For i = 1 To 11
        strField = strField & "," & "F" & i
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 26
        strSQL = strSQL & " union all select " & strField & " from [" & i & "$a18:k] where F5 is not null and F7>0"
    Next
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
        Sheet14.Range("a3").CopyFromRecordset .Execute(Right(strSQL, Len(strSQL) - 10))
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ, đúng rồi ạ. Em cảm ơn nhiều!
Nếu được ,bác làm thêm giúp em, ở mỗi sheet lấy thêm ô B7 và I7 sau cột USD
Thật sự là vì công thức này em k hiểu được, nên k sửa đc
 
mshuyenvn đã viết:
Dạ, đúng rồi ạ. Em cảm ơn nhiều!
Nếu được ,bác làm thêm giúp em, ở mỗi sheet lấy thêm ô B7 và I7 sau cột USD
Thật sự là vì công thức này em k hiểu được, nên k sửa đc
Nhấp chuột vào đây để mở rộng...
Tôi chỉ có thể làm được như sau:

Mã: 
Sub LayDL_HLMT()
    Dim strField, strSQL As String
    Dim i  As Integer
    For i = 1 To 11
        strField = strField & "," & "F" & i
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 26
        strSQL = strSQL & " union all select " & strField & ",(Select F1 & ' - ' & F8 from [" & i & "$B7:I7]) from [" & i & "$a18:k] where F5 is not null and F7>0"
    Next
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
        Sheet14.Range("a3").CopyFromRecordset .Execute(Right(strSQL, Len(strSQL) - 10))
    End With
End Sub
 
Hai Lúa Miền Tây đã viết:
Tôi chỉ có thể làm được như sau:

Mã: 
Sub LayDL_HLMT()
    Dim strField, strSQL As String
    Dim i  As Integer
    For i = 1 To 11
        strField = strField & "," & "F" & i
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 26
        strSQL = strSQL & " union all select " & strField & ",(Select F1 & ' - ' & F8 from [" & i & "$B7:I7]) from [" & i & "$a18:k] where F5 is not null and F7>0"
    Next
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
        Sheet14.Range("a3").CopyFromRecordset .Execute(Right(strSQL, Len(strSQL) - 10))
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Vậy là cũng tốt rồi, chân thành cảm ơn bác nhiều!
 
mshuyenvn đã viết:
Vậy là cũng tốt rồi, chân thành cảm ơn bác nhiều!
Nhấp chuột vào đây để mở rộng...
Lở rồi làm luôn cho bạn:
Mã: 
Sub LayDL_HLMT()
    Dim strField, strSQL As String
    Dim i  As Integer
    For i = 1 To 11
        strField = strField & "," & "F" & i
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 26
        strSQL = strSQL & " union all select " & strField & ", (Select F1 from [" & i & "$B7:I7]), (Select F8 from [" & i & "$B7:I7])  from [" & i & "$a18:k] where F5 is not null and F7>0"
    Next
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
        Sheet14.Range("a3").CopyFromRecordset .Execute(Right(strSQL, Len(strSQL) - 10))
    End With
End Sub
 
Hai Lúa Miền Tây đã viết:
Lở rồi làm luôn cho bạn:
Mã: 
Sub LayDL_HLMT()
    Dim strField, strSQL As String
    Dim i  As Integer
    For i = 1 To 11
        strField = strField & "," & "F" & i
    Next
    strField = Right(strField, Len(strField) - 1)
    For i = 1 To 26
        strSQL = strSQL & " union all select " & strField & ", (Select F1 from [" & i & "$B7:I7]), (Select F8 from [" & i & "$B7:I7])  from [" & i & "$a18:k] where F5 is not null and F7>0"
    Next
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";"
        Sheet14.Range("a3").CopyFromRecordset .Execute(Right(strSQL, Len(strSQL) - 10))
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Ngàn like cho bác !!!
 

File đính kèm

Ok em sửa được rồi!
 
Lần chỉnh sửa cuối:
Nhờ mọi người giúp em với ạ. Em có 1 file excel với nhiều sheet khác nhau, cấu trúc giống nhau, nội dung ở các dòng khác nhau. Em cần tạo một sheet tổng hợp toàn bộ dữ liệu của các sheet còn lại. Và khi nhập thêm vào các sheet nhỏ(nội dung, chèn dòng...) thì ở sheet tổng hợp cũng tự động thay đổi thêm vào. Em có tham khảo qua trên mạng thấy mọi người dùng marco, vba ... Em ít sử dụng excel, chưa bao giờ dùng mấy cái này nên nghiên cứu mãi chưa ra. Em gửi file ví dụ. Mọi người chỉ giúp em chi tiết hơn một chút được không ạ. Em cảm ơn !
 

File đính kèm

Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

8
Theo dõi bán hàng
Trả lời
5
Đọc
77
84huong
8
minhduc1o2
Hình ảnh bị lỗi #VALUE (1 người xem)
Trả lời
4
Đọc
50
minhduc1o2
minhduc1o2
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
276
Đọc
35K
ongke0711
ongke0711
S
tỷ lệ % không khớp khi cộng tổng (1 người xem)
Trả lời
2
Đọc
36
snoobcool
S
D
Tên sheet bị che khuất khi thực hiện sửa tên sheet (2 người xem)
Trả lời
1
Đọc
223
PhamMaiTB
P
Nguyenkhang2404
Tính định mức sản phẩm (1 người xem)
    • Chấp nhận
Trả lời
4
Đọc
152
Nguyenkhang2404
Nguyenkhang2404
thanhcongdnk
nhờ các cao nhân giúp dùm, xin đa tạ nhiều
    • Buồn
    • Phẫn nộ
Trả lời
2
Đọc
397
misibi
M
N
  • Question Question
Chia sẻ COM DLL giúp tra cứu mã số thuế từ trang web masothue.com
    • Thích
Trả lời
1
Đọc
386
nguyendang95
N
hoidebiet1710
Doanh thu cho nhiều nhân viên bán hàng
Trả lời
1
Đọc
75
BuiQuangThuan
B
T
Ngắt kết nối với tệp lệnh đính kèm
Trả lời
1
Đọc
47
Hoàng Tuấn 868
H
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ) (1 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
1
Đọc
102
hoidebiet1710
hoidebiet1710
V
  • Question Question
Nhờ mọi người giúp cách xóa các mục đã chọn trong Droplist của một nhóm các ô cùng dạy một môn học.
Trả lời
3
Đọc
191
HUONGHCKT
H
L
Trừ lùi nguyên vật liệu nhập - xuất - tồn theo nhiều điều kiện
Trả lời
7
Đọc
748
oanhleqt
O
D
Lọc cột chứa nhiều nhóm từ trong Excel. Mong các bạn giải đáp giúp
Trả lời
8
Đọc
171
Thai Huyen
Thai Huyen
T
file excel bị lỗi (1 người xem)
Trả lời
1
Đọc
37
BuiQuangThuan
B
dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định
Trả lời
4
Đọc
135
HUONGHCKT
H
H
Câu lệnh mở file Excel trong Macbook Pro 1
Trả lời
0
Đọc
47
huafu_Jackl
H
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
8
Đọc
785
nguyendang95
N
PhanTuHuong
Chương trình lập Báo cáo khảo sát Địa chất công trình GeoSection
    • Thích
Trả lời
8
Đọc
6K
PhanTuHuong
PhanTuHuong
V
  • Question Question
Xác định xu hướng cấp 1,2,3
Trả lời
0
Đọc
63
vuthienfx
V
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom