Xin giúp em copy cột C ở tất cả các sheet vào file import_template. Em cảm ơn ạ. (1 người xem)

[thuong.dothict]

Xin giúp em copy cột C ở tất cả các sheet vào file import_template. Em cảm ơn ạ.

 

[BuiQuangThuan]

Xin giúp em copy cột C ở tất cả các sheet vào file import_template. Em cảm ơn ạ.

Bạn muốn làm tự động hả?
Các sheet trong file 3.3 Khối lượng…. Ấy có đồng nhất các dòng đâu nhỉ?Và cái bạn đang muốn là muốn là đối tượng nào ở dòng nào thì phải điền vào dòng đó phải không?

 

[thuong.dothict]

Dạ hiện tại em combine tất cả các sheet rồi match lại với nhau, em muốn nhờ các cao nhân chỉ thêm cách tối ưu hơn ạ.

 

[yaaasoo01]

Yêu cầu của bạn chưa rõ lắm, có nguồn để copy rồi nhưng chưa biết paste vào đâu. Bạn hãy gửi cách bạn đang làm hiện tại và file import mẫu mà bạn đã xử lí (cho 1 vài sheet VD thôi)

 

[thuong.dothict]

Dạ em lấy cột khối lượng (Cột C) và % (cột E) từng sheet ra kết quả như file ạ.

 

[HUONGHCKT]

Dạ em lấy cột khối lượng (Cột C) và % (cột E) từng sheet ra kết quả như file ạ.

Không phải là cao nhân, cao chia gì có được trợ giúp không?
Nếu làm bàng VBA có được không?
Nếu được có thể tham khảo code VBA sau:
(lưu ý có thể code chỉ chạy cho kết quả đúng như file đính kèm_ hiện tại kết quả đang để ở AH6:BS38/Sheet1 -Sheet chứa code)
nhấn vào nút mũi tên để được kết quả.
Với yêu cầu là tự động bạn chủ thớt tự tìm hiểu

Option Explicit

Sub Copy()

Dim i&, j&, Lr&, t&, k&, sR&, R&, C&, n&
Dim Arr(), KQ()
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet, Wb As Workbook
Dim FileDL As String

Set Sh = Sheet1
Set Dic = CreateObject("Scripting.Dictionary")
Lr = Sh.Range("A100000").End(xlUp).Row
For i = 6 To Lr
    Key = Sh.Range("B" & i)
        t = t + 1: Dic.Add (Key), t
Next

FileDL = Application.GetOpenFilename("File excel,*.xls?")
    If FileDL <> "False" Then
        Set Wb = Workbooks.Open(FileDL)
        ReDim KQ(1 To Dic.Count, 1 To (Wb.Sheets.Count) * 2)
        For Each Ws In Wb.Sheets
            If Left(Ws.Name, 1) = "Q" Then
                Lr = Ws.Range("A100000").End(xlUp).Row
                sR = Ws.Range("A1").End(xlDown).Row
                Arr = Ws.Range("A" & sR & ":H" & Lr).Value
                R = UBound(Arr): n = n + 1: C = 2 * n - 1
                For i = 1 To R
                    Key = Trim(Arr(i, 1))
                    If Dic.Exists(Key) Then
                        k = Dic.Item(Key)
                        KQ(k, C) = Arr(i, 3)
                        KQ(k, C + 1) = Arr(i, 4)
                    End If
                Next i
            End If
        Next Ws
        Wb.Close SaveChanges:=False
    End If
If n Then
    Sh.Range("AH6").Resize(10000, 1000).ClearContents
    Sh.Range("AH6").Resize(Dic.Count, C + 1) = KQ
End If
MsgBox "Done"
Set Dic = Nothing
End Sub

 

[DeTong]

Thêm 1 giải pháp cho thớt tham khảo;.
Combine Sheet bằng Query

 

[thuong.dothict]

Không phải là cao nhân, cao chia gì có được trợ giúp không?
Nếu làm bàng VBA có được không?
Nếu được có thể tham khảo code VBA sau:
(lưu ý có thể code chỉ chạy cho kết quả đúng như file đính kèm_ hiện tại kết quả đang để ở AH6:BS38/Sheet1 -Sheet chứa code)
nhấn vào nút mũi tên để được kết quả.
Với yêu cầu là tự động bạn chủ thớt tự tìm hiểu

Option Explicit

Sub Copy()

Dim i&, j&, Lr&, t&, k&, sR&, R&, C&, n&
Dim Arr(), KQ()
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet, Wb As Workbook
Dim FileDL As String

Set Sh = Sheet1
Set Dic = CreateObject("Scripting.Dictionary")
Lr = Sh.Range("A100000").End(xlUp).Row
For i = 6 To Lr
    Key = Sh.Range("B" & i)
        t = t + 1: Dic.Add (Key), t
Next

FileDL = Application.GetOpenFilename("File excel,*.xls?")
    If FileDL <> "False" Then
        Set Wb = Workbooks.Open(FileDL)
        ReDim KQ(1 To Dic.Count, 1 To (Wb.Sheets.Count) * 2)
        For Each Ws In Wb.Sheets
            If Left(Ws.Name, 1) = "Q" Then
                Lr = Ws.Range("A100000").End(xlUp).Row
                sR = Ws.Range("A1").End(xlDown).Row
                Arr = Ws.Range("A" & sR & ":H" & Lr).Value
                R = UBound(Arr): n = n + 1: C = 2 * n - 1
                For i = 1 To R
                    Key = Trim(Arr(i, 1))
                    If Dic.Exists(Key) Then
                        k = Dic.Item(Key)
                        KQ(k, C) = Arr(i, 3)
                        KQ(k, C + 1) = Arr(i, 4)
                    End If
                Next i
            End If
        Next Ws
        Wb.Close SaveChanges:=False
    End If
If n Then
    Sh.Range("AH6").Resize(10000, 1000).ClearContents
    Sh.Range("AH6").Resize(Dic.Count, C + 1) = KQ
End If
MsgBox "Done"
Set Dic = Nothing
End Sub

dạ em cảm ơn anh nhiều ạ

Bài đã được tự động gộp: 30/12/24

Thêm 1 giải pháp cho thớt tham khảo;.
Combine Sheet bằng Query

dạ em cảm ơn anh nhiều ạ.