Lọc và coppy dữ liệu qua 1 file khác (4 người xem)

[BuiQuangThuan]

Chào thầy cô. em có file đơn hàng đính kèm.
Dòng 7 em filter

Cột A lọc lấy 2 và 9

Cột B lọc lấy (Blanks)

Cột C trừ những đơn hàng có chứa “ SAM”

Sau đó em muốn copy vùng có dữ liệu (từ dòng 7 đến dòng cuối cùng có dữ liệu) những cột sau:

“C,G,I,J,K, L, M, U, X “

Sang 1 sheet mới của workbook mới tại desktop có tên “TongHop” tại ô A2.
Nhờ anh có thể viết cho em đoạn code được ko a (lý do làm việc này là do em ko sử dụng được Pivot table cho cái file em đính kèm)
xin cám ơn ạ

 

[befaint]

Anh/ chị nào làm bài này với dạng đọc và ghi dữ liệu vào file đóng cho mình tham khảo với.

 

[BuiQuangThuan]

Anh/ chị nào làm bài này với dạng đọc và ghi dữ liệu vào file đóng cho mình tham khảo với.

Bác này viết code ầm ầm mà vẫn phải tham khảo ạ. Hihi

 

[tieuthubuongbinh]

Anh/ chị nào làm bài này với dạng đọc và ghi dữ liệu vào file đóng cho mình tham khảo với.

Bác mà phải tham khảo à? Em có đọc nhầm không ạ? hihi

@buiquangthuan bạn tham khảo code của GPE

Sub CopyNewWb()
Dim newWb As Workbook, sArr(), i As Long, j As Long, reArr()
sArr = Sheet1.Range("A7:AC" & Sheet1.Range("A65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 9)
For i = 1 To UBound(sArr, 1)
    If (sArr(i, 1) = 2 Or sArr(i, 1) = 9) And sArr(i, 2) = "" And _
        Not sArr(i, 3) Like "*SAM*" Then
        j = j + 1: reArr(j, 1) = sArr(i, 3)
         reArr(j, 2) = sArr(i, 7): reArr(j, 3) = sArr(i, 9)
        reArr(j, 4) = sArr(i, 10): reArr(j, 5) = sArr(i, 11)
        reArr(j, 6) = sArr(i, 12): reArr(j, 7) = sArr(i, 13)
        reArr(j, 8) = sArr(i, 21): reArr(j, 9) = sArr(i, 24)
    End If
Next i
If j Then
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
        Set newWb = Application.Workbooks.Add(1)
        With newWb
            .Sheets(1).Range("A2").Resize(j, 9) = reArr
            .Sheets(1).Range("A2").Resize(j, 9).Columns.AutoFit
            .SaveAs Filename:="C:\Users\MyPC\Desktop\" & "Ten file", FileFormat:=51
        End With
        newWb.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End If
End Sub

 

[BuiQuangThuan]

Bác mà phải tham khảo à? Em có đọc nhầm không ạ? hihi

@buiquangthuan bạn tham khảo code của GPE

Sub CopyNewWb()
Dim newWb As Workbook, sArr(), i As Long, j As Long, reArr()
sArr = Sheet1.Range("A7:AC" & Sheet1.Range("A65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 9)
For i = 1 To UBound(sArr, 1)
    If (sArr(i, 1) = 2 Or sArr(i, 1) = 9) And sArr(i, 2) = "" And _
        Not sArr(i, 3) Like "*SAM*" Then
        j = j + 1: reArr(j, 1) = sArr(i, 3)
         reArr(j, 2) = sArr(i, 7): reArr(j, 3) = sArr(i, 9)
        reArr(j, 4) = sArr(i, 10): reArr(j, 5) = sArr(i, 11)
        reArr(j, 6) = sArr(i, 12): reArr(j, 7) = sArr(i, 13)
        reArr(j, 8) = sArr(i, 21): reArr(j, 9) = sArr(i, 24)
    End If
Next i
If j Then
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
        Set newWb = Application.Workbooks.Add(1)
        With newWb
            .Sheets(1).Range("A2").Resize(j, 9) = reArr
            .Sheets(1).Range("A2").Resize(j, 9).Columns.AutoFit
            .SaveAs Filename:="C:\Users\MyPC\Desktop\" & "Ten file", FileFormat:=51
        End With
        newWb.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End If
End Sub

Cảm ơn bác rất nhiều để em test thử đã rồi báo lại kết quả sau ạ

 

[befaint]

Bác mà phải tham khảo à? Em có đọc nhầm không

Mình muốn tham khảo code trường hợp không cần thao tác tay mở file dữ liệu ban đầu lên..
Và nếu ghi kết quả nối tiếp vào file đã có thì càng tốt.
Nếu có code ADO thì hay quá..

 

[tieuthubuongbinh]

Mình muốn tham khảo code trường hợp không cần thao tác tay mở file dữ liệu ban đầu lên..
Và nếu ghi kết quả nối tiếp vào file đã có thì càng tốt.
Nếu có code ADO thì hay quá..

Code này em tham khảo chứ em không có viết bác ơi, em là 0 với vba đó ạ.