[Trợ giúp] Chép dữ liệu sáng sheet khác có điều kiện

Liên hệ QC

hmgiang2009

Thành viên chính thức
Tham gia
16/7/11
Bài viết
74
Được thích
5
Xin chào mọi người!
Mình xin được giúp đỡ một vấn đề chép dữ liệu sang nhiều sheet như sau:
- Như trong file mình đính kèm, ở sheet 1 mình muốn khi lick vào TẠO BÁO CÁO thì dữ liệu trong bảng sẽ được chép qua theo mẫu ở sheet 2 với số lượng và giá trị tồn tính đến ngày 04/11/2016 trong ô G2.
Xin cảm ơn rất nhiều!!
S1.jpg
S2.jpg
 

File đính kèm

  • Book2.xls
    59 KB · Đọc: 8
Của bạn đây, bạn xem được chưa?
 

File đính kèm

  • Book21.xlsm
    28.5 KB · Đọc: 11
Upvote 0
Xin chào mọi người!
Mình xin được giúp đỡ một vấn đề chép dữ liệu sang nhiều sheet như sau:
- Như trong file mình đính kèm, ở sheet 1 mình muốn khi lick vào TẠO BÁO CÁO thì dữ liệu trong bảng sẽ được chép qua theo mẫu ở sheet 2 với số lượng và giá trị tồn tính đến ngày 04/11/2016 trong ô G2.
Xin cảm ơn rất nhiều!!
Bạn chạy thử cái này xem sao:
Sub Baocao()


Dim sArr(), dArr(), Ngay
Dim i As Long, j As Long, k As Long

With Sheet1
sArr = .Range("A6", .Range("A65535").End(3)).Resize(, 7)
End With

ReDim dArr(1 To UBound(sArr), 1 To 7)
Ngay = Sheet1.Range("G2")
For i = 1 To UBound(sArr)
If sArr(i, 7) = Empty Or sArr(i, 7) > Ngay Then
k = k + 1
dArr(k, 1) = k
For j = 2 To 7
dArr(k, j) = sArr(i, j)
Next j
End If
Next i
With Sheet2
.Range("A7:G65535").Borders.LineStyle = xlNone
.Range("A7:G65535").ClearContents
.Range("A7").Resize(k, 7) = dArr
.Range("A7").Resize(k, 7).Borders.LineStyle = 1
End With


End Sub
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Của bạn đây, bạn xem được chưa?
Xin cảm ơn bạn miphp đã trợ giúp cho mình!
Do mình không rành cho lắm cái vụ VBA nên khi ứng dụng vào file mình xây dựng thì lại bị khó khăn ở chỗ:
- Cái file mình làm vd thì khi tạo dữ liệu báo cáo theo thứ tự từ cột A6 cho đến cột G6, còn cái file mình dây dựng thì lấy dữ liệu nó không theo thứ tự cột cụ thể như là từ Bảng dữ liệu ở sheet 1 mình có cột C12 thì khi báo cáo sang sheet2 thì nó lại nằm ở ô C5, E12 sang D5, F12 sang E5... thì mình sửa code như thể nào hả bạn
Rất mong được bạn giúp đõ thêm cho mình, xin cảm ơn.
 
Upvote 0
Bạn mở VBA lên xem đoạn này.

Sheet2.Cells(LR23 + 1, 2) = Sheet1.Cells(i, 2)
Sheet2.Cells(LR23 + 1, 3) = Sheet1.Cells(i, 3)
Sheet2.Cells(LR23 + 1, 4) = Sheet1.Cells(i, 4)
Sheet2.Cells(LR23 + 1, 5) = Sheet1.Cells(i, 5)
Sheet2.Cells(LR23 + 1, 6) = Sheet1.Cells(i, 6)
Sheet2.Cells(LR23 + 1, 7) = Sheet1.Cells(i, 7)

chữ màu đỏ là thứ tự của cột trong sheet (cột A = 1, B =2, C =3..)
bạn thử thay đổi số màu đỏ trong code và xem kết quả đi.
(lưu ý, với dữ liệu lớn, làm theo cách của m sẽ bị chậm, do thao tác trực tiếp trên từng cells, nhiều dữ liệu bạn nên tham khảo cách của bạn Shavara36)
nếu chưa hiểu bạn có thể đưa file thực tế của bạn cho mọi người giúp.
 
Upvote 0
Bạn mở VBA lên xem đoạn này.
(lưu ý, với dữ liệu lớn, làm theo cách của m sẽ bị chậm, do thao tác trực tiếp trên từng cells, nhiều dữ liệu bạn nên tham khảo cách của bạn Shavara36)
nếu chưa hiểu bạn có thể đưa file thực tế của bạn cho mọi người giúp.
Xin cảm ơn 2 bạn Sharava36 và bạn miphp nhiều!
Chắc để cho nhanh gọn mình xin gửi file thực tế lên cho nhanh quá, mong 2 bạn giúp đỡ cho mình thêm
Xin cảm ơn rất nhiều
 

File đính kèm

  • Theo doi.xlsm
    92.5 KB · Đọc: 15
Upvote 0
Xin cảm ơn 2 bạn Sharava36 và bạn miphp nhiều!
Chắc để cho nhanh gọn mình xin gửi file thực tế lên cho nhanh quá, mong 2 bạn giúp đỡ cho mình thêm
Xin cảm ơn rất nhiều
Mã:
Option Explicit


Public Sub GPE()
Dim sArr, dArr, I As Long, J As Long, K As Long
sArr = Sheet1.Range("A11").CurrentRegion.Value
ReDim dArr(1 To UBound(sArr), 1 To 7)
Application.ScreenUpdating = False
For I = 2 To UBound(sArr)
If sArr(I, 7) <> Empty Then
    If sArr(I, 10) = Empty Or sArr(I, 10) > Sheet1.Range("J6").Value Then
        K = K + 1
        dArr(K, 1) = K
        dArr(K, 2) = sArr(I, 7)
        dArr(K, 3) = sArr(I, 3)
        dArr(K, 4) = sArr(I, 5)
        dArr(K, 5) = sArr(I, 6)
        dArr(K, 6) = sArr(I, 9)
        dArr(K, 7) = sArr(I, 12)
    End If
End If
Next I
With Sheet3
    .Range("A5:G379").ClearContents
    .Range("A5").Resize(K, 7) = dArr
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Web KT
Back
Top Bottom