COPY dữ liệu từ các sheet vào sheet tổng hợp (1 người xem)

[bth8320]

Chào cả nhà.

Mình có vấn đề này nhờ cả nhà giúp đỡ.

Mình có file tổng hợp vật tư thiết bị của các tháng trong năm.
Trong đó VTTB đã được đánh mã số ở cột A của mỗi sheet.
Mình muốn tổng hợp về sheet DATABASE bằng cách bấm nút chọn.
Userform hiện ra, trong đó combobox đã hiển thị các mx số thiết bị.
Khi chọn 1 mã số bất kỳ thì code sẽ chạy để copy(nội dung từ cột A đến cột R) tất cả các mã thỏa điều kiện ở tất cả các sheet và paste về sheet DATABASE.

khi chọn mà khác thì sheet DATABASE sẽ clear toàn bộ nội dung cũ và hiển thị nội dung mới.

Nhờ cả nhà giúp đỡ.

 

[vanaccex]

Chào cả nhà.

Mình có vấn đề này nhờ cả nhà giúp đỡ.

Mình có file tổng hợp vật tư thiết bị của các tháng trong năm.
Trong đó VTTB đã được đánh mã số ở cột A của mỗi sheet.
Mình muốn tổng hợp về sheet DATABASE bằng cách bấm nút chọn.
Userform hiện ra, trong đó combobox đã hiển thị các mx số thiết bị.
Khi chọn 1 mã số bất kỳ thì code sẽ chạy để copy(nội dung từ cột A đến cột R) tất cả các mã thỏa điều kiện ở tất cả các sheet và paste về sheet DATABASE.

khi chọn mà khác thì sheet DATABASE sẽ clear toàn bộ nội dung cũ và hiển thị nội dung mới.

Nhờ cả nhà giúp đỡ.

Bạn thử xem code sau

Private Sub CommandButton6_Click()
Dim Sh As Worksheet, ArrData, ArrResult(), i As Long, j As Long, k As Long, Check As Boolean
With Sheets("DATABASE")
 .Range("A2:Q" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
End With
ReDim ArrResult(0 To &H10000, 1 To 17)
For Each Sh In ThisWorkbook.Sheets
    If Sh.Name <> "DATABASE" Then
        ArrData = Sh.Range("A2:Q" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Value
        For i = 1 To UBound(ArrData, 1)
         If ArrData(i, 1) = ComboBox1.Text Then
            Check = False
            For j = 1 To UBound(ArrData, 2)
                If Not IsEmpty(ArrData(i, j)) Then
                    Check = True
                    ArrResult(k, j) = ArrData(i, j)
                End If
            Next
            If Check Then
                k = k + 1
            End If
          End If
        Next
    End If
Next
If k > 0 Then Sheets("DATABASE").Range("A2").Resize(k, 17).Value = ArrResult
End Sub

 

[SA_DQ]

. . . . Mình muốn tổng hợp về sheet DATABASE bằng cách bấm nút chọn.
Userform hiện ra, trong đó combobox đã hiển thị các mx số thiết bị.
Khi chọn 1 mã số bất kỳ thì code sẽ chạy để copy(nội dung từ cột A đến cột R) tất cả các mã thỏa điều kiện ở tất cả các sheet và paste về sheet DATABASE.
khi chọn mà khác thì sheet DATABASE sẽ clear toàn bộ nội dung cũ và hiển thị nội dung mới. . . . .

Hình như bạn chỉ cần xem dữ liệu thôi, phải không?
Nếu đúng vậy thì thay vì hiện trên trang 'TongHop' ta có thể cho hiện trên ListBox của Form ý được không?

 

[bth8320]

Hình như bạn chỉ cần xem dữ liệu thôi, phải không?
Nếu đúng vậy thì thay vì hiện trên trang 'TongHop' ta có thể cho hiện trên ListBox của Form ý được không?

Dạ mình cần hiển thị trên trang database để lấy dữ liệu làm tiếp việc khác.

 

[bth8320]

Bạn thử xem code sau

Private Sub CommandButton6_Click()
Dim Sh As Worksheet, ArrData, ArrResult(), i As Long, j As Long, k As Long, Check As Boolean
With Sheets("DATABASE")
.Range("A2:Q" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
End With
ReDim ArrResult(0 To &H10000, 1 To 17)
For Each Sh In ThisWorkbook.Sheets
    If Sh.Name <> "DATABASE" Then
        ArrData = Sh.Range("A2:Q" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Value
        For i = 1 To UBound(ArrData, 1)
         If ArrData(i, 1) = ComboBox1.Text Then
            Check = False
            For j = 1 To UBound(ArrData, 2)
                If Not IsEmpty(ArrData(i, j)) Then
                    Check = True
                    ArrResult(k, j) = ArrData(i, j)
                End If
            Next
            If Check Then
                k = k + 1
            End If
          End If
        Next
    End If
Next
If k > 0 Then Sheets("DATABASE").Range("A2").Resize(k, 17).Value = ArrResult
End Sub

Mình gặp vấn đề phát sinh cần bạn va mọi người giúp thêm.
Trong bảng VTTB các tháng thì ngoài các mã số như: VPP-001-01 có xuất hiện thêm mã phụ của mã này như:VPP-001-01-01,VPP-001-01-02,...

Mình cần khi chọn mã số VPP-001-01 thì các mã số VPP-001-01-01,VPP-001-01-02,... cũng được copy luôn.

Nhờ mọi người xem giúp sẽ phải sửa code này theo hướng nào để đáp ứng việc trên.

 

[Phuocam]

Private Sub CommandButton6_Click()
Dim Sh As Worksheet, ArrData, ArrResult(), i As Long, j As Long, k As Long, Check As Boolean
Dim temp As String ' thêm  dòng này 
temp = ComboBox1.Text & "*" ' thêm  dòng này
With Sheets("DATABASE")
 .Range("A2:Q" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
End With
ReDim ArrResult(0 To &H10000, 1 To 17)
For Each Sh In ThisWorkbook.Sheets
    If Sh.Name <> "DATABASE" Then
        ArrData = Sh.Range("A2:Q" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Value
        For i = 1 To UBound(ArrData, 1)
         If ArrData(i, 1) Like temp Then 'Sửa dòng này
            Check = False
            For j = 1 To UBound(ArrData, 2)
                If Not IsEmpty(ArrData(i, j)) Then
                    Check = True
                    ArrResult(k, j) = ArrData(i, j)
                End If
            Next
            If Check Then
                k = k + 1
            End If
          End If
        Next
    End If
Next
If k > 0 Then Sheets("DATABASE").Range("A2").Resize(k, 17).Value = ArrResult
End Sub