tổng hợp dữ liệu từ nhiều sheet va 1 sheet qua 1 sheet theo yêu cầu (2 người xem)

[chuotchuix]

mấy anh sữa dùm e code với sao em sữa nó ko chạy đúng như ý em.sheet plan giờ em muốn lấy dữ liệu từ AN6 của các sheet kia chứ ko lấy từ AN4 nữa. và sheet plan-in e muốn lấy dữ liệu từ sheet plan chạy về như e dâng làm nơi em chi lấy được cái đầu còn phần dưới ko biết làm sao.mong các anh xem dùm e. file e đưa lên đây
http://www.mediafire.com/download/be...AM+KH-Temp.zip

 

[chuotchuix]

đây là code
On Error Resume Next
n = 0
Set rng = wks.[AN2]
Do While rng(1, 1).Value <> ""
n = n + 1
Set rng = wks.[AN2].Offset(4, (n - 1) * 10).Resize(300, 10)
With Sheet1.[I60000].End(3).Offset(1)
.Offset(, -8).Resize(300, 10).Value = rng.Value
.Offset(, 1).Resize(300, 1).Value = rng.Offset(-3)(1, 1).Value

End With
Loop
End Sub


Sub RUN()
Dim ws As Worksheet, Arrsh As String
Sheet1.[A4].Resize(60000, 13).ClearContents
Application.ScreenUpdating = False
' On Error Resume Next
Arrsh = "?QCCHO?ORDER?ONLINE?PLAN?"
For Each ws In Worksheets
If InStr(1, Arrsh, "?" & ws.Name & "?", vbTextCompare) = 0 Then
'MsgBox ws.Name
abc ws
End If
Next
Sheet1.[A2].Resize(60000, 13).RemoveDuplicates Columns:=Array(2, 3, 4, 5, 6), Header:=xlNo

Sheet1.[J3] = "MAY"
Sheet1.[A4].Resize(60000, 13).Sort ActiveSheet.Range("j3"), 1
Application.ScreenUpdating = 1

End Sub

 

[chuotchuix]

Ko co bác nao giup e 1 ve voi.code o trên e sua ti ma ko chay ko ra nhu Yeu cau cua e

 

[SA_DQ]

Riêng mình thì mình chỉ có thể giúp trong khả năng với những người viết Code có khai báo tường minh mà thôi!

 

[Lê Duy Thương]

Sửa lại cái màu đỏ cho sheet plan xem sao ??

Sub abc(ByVal wks As Worksheet)
  Dim i As Long, n As Long, rng As Range
  On Error Resume Next
  n = 0
  Set rng = wks.[AN2]
  Do While rng(1, 1).Value <> ""
    n = n + 1
    Set rng = wks.[AN2].[B][COLOR=#ff0000]Offset(4, (n - 1) * 10)[/COLOR][/B].Resize(300, 10)
    With Sheet1.[j60000].End(3).Offset(1)
      .Offset(, -8).Resize(300, 10).Value = rng.Value
      .Offset(, -9).Resize(300, 1).Value = rng.[COLOR=#ff0000][B]Offset(-5)[/B][/COLOR](1, 1).Value
    
    End With
  Loop
End Sub


Sub RUN()
Dim ws As Worksheet, Arrsh As String
  Sheet1.[A4].Resize(60000, 10).ClearContents
  Application.ScreenUpdating = False
  ' On Error Resume Next
    Arrsh = "?QCCHO?ORDER?ONLINE?PLAN?plan-IN?"
    For Each ws In Worksheets
      If InStr(1, Arrsh, "?" & ws.Name & "?", vbTextCompare) = 0 Then
         'MsgBox ws.Name
        abc ws
       End If
          Next
  Sheet1.[A2].Resize(60000, 10).RemoveDuplicates Columns:=Array(2, 3, 4, 5, 6), Header:=xlNo
  
   Sheet1.[A3] = "MAY"
   Sheet1.[A4].Resize(60000, 10).Sort ActiveSheet.Range("A3"), 1
   Application.ScreenUpdating = 1
   
End Sub

 

[chuotchuix]

em đổi lại như thế cả chục lần rồi nhưng kết quả dàn máy no chạy ko đúng anh thương nó bỏ bớt nhiều máy lắm máy số 2,9,10... co mà nó ko ra

 

[Quang_Hải]

em đổi lại như thế cả chục lần rồi nhưng kết quả dàn máy no chạy ko đúng anh thương nó bỏ bớt nhiều máy lắm máy số 2,9,10... co mà nó ko ra

Nếu như bạn xóa bớt dữ liệu, làm sao cũng được miễn là file dưới 100kb và post tại diễn đàn thì mình sẽ xem giúp cho. File nặng hơn mình tải không nổi.

 

[chuotchuix]

Nếu như bạn xóa bớt dữ liệu, làm sao cũng được miễn là file dưới 100kb và post tại diễn đàn thì mình sẽ xem giúp cho. File nặng hơn mình tải không nổi.

cảm ơn anh quang hai.nhưng file e mà xóa hết còn dưới 100kd thì nó sẽ mất hết các dữ liệu mình làm và anh se khóa sữa được dùm e vì tất cả điều liên quan tới nhau

 

[chuotchuix]

anh leduythuong và bác ndu ơi vào giúp e 1 vé với

 

[chuotchuix]

cuối cùng sau một hồi suy nghĩ cũng đã làm được