xin các thầy và các cô giúp em tạo một đoạn code lấy dữ liệu (1 người xem)

[gamegamegamegame]

ý tưởng của em muống tạo một nút cập nhật dữ liệu từ file DULIEU.xlsx sang file XUẤT NHẬP.xls Sheet nhập-xuất
mail của em là : tranbaoson21@gmail.com

 

[doveandrose]

đưa dữ liệu giống giỡn chơi quá . copy sheet DU LIEU rồi biết paste vào phần NHẬP hay XUẤT ?

 

[gamegamegamegame]

đưa dữ liệu giống giỡn chơi quá . copy sheet DU LIEU rồi biết paste vào phần NHẬP hay XUẤT ?

vào sheet nhập-xuất trong file XUẤT NHẬP.xls đó bạn

 

[gamegamegamegame]

đưa dữ liệu giống giỡn chơi quá . copy sheet DU LIEU rồi biết paste vào phần NHẬP hay XUẤT ?

ý sơn là tạo một đoạn code lấy tât cả chỉ số như
ngày
số hoá đơn
stthh
tên hàng
số lượng
từ file DULIEU.xlsx
sang file XUAT NHAP.xls sheet nhap-xuat
phần số lượng từ file DULIEU.xlsx nhập vào phần "xuất trong kỳ" trong sheet nhap-xuat

 

[gamegamegamegame]

sao khi ấn nút cập nhập thi file XUAT NHAP.xls se như file sơn úp ở dưới được tô màu xanh

 

[doveandrose]

Public Sub hello()


Dim wsSource As Worksheet, wsNX As Worksheet, arr As Variant, lr As Long, r As Long, fr As Long
Dim mArr As Variant, hArr As Variant, qArr As Variant
Set wsSource = Workbooks("DULIEU.xlsx").Worksheets("DU LIEU")
Set wsNX = Workbooks("XUAT NHAP.xls").Worksheets("Nhap-Xuat")
lr = wsSource.Range("D1000000").End(xlUp).Row
If lr > 3 Then
    Application.ScreenUpdating = False
    arr = wsSource.Range("A4:E" & lr).Value
    ReDim hArr(1 To UBound(arr), 1 To 3)
    ReDim qArr(1 To UBound(arr), 1 To 1)
    ReDim mArr(1 To UBound(arr), 1 To 1)
    For r = 1 To UBound(arr) Step 1
        qArr(r, 1) = arr(r, 5)
        mArr(r, 1) = arr(r, 4)
        hArr(r, 2) = arr(r, 2)
        hArr(r, 3) = arr(r, 1)
        If WorksheetFunction.Trim(arr(r, 2)) = "" Then
            hArr(r, 1) = hArr(WorksheetFunction.Max(r - 1, 1), 1)
        Else
            hArr(r, 1) = "PX" & Format(arr(r, 2), "00")
        End If
    Next
    fr = wsNX.Range("A65000").End(xlUp).Row + 1
    lr = fr + UBound(arr) - 1
    wsNX.Range("A" & fr & ":C" & lr).Value = hArr
    wsNX.Range("K" & fr & ":K" & lr).Value = mArr
    wsNX.Range("Q" & fr & ":Q" & lr).Value = qArr
    Application.ScreenUpdating = True
End If


End Sub

 

[gamegamegamegame]

Public Sub hello()


Dim wsSource As Worksheet, wsNX As Worksheet, arr As Variant, lr As Long, r As Long, fr As Long
Dim mArr As Variant, hArr As Variant, qArr As Variant
Set wsSource = Workbooks("DULIEU.xlsx").Worksheets("DU LIEU")
Set wsNX = Workbooks("XUAT NHAP.xls").Worksheets("Nhap-Xuat")
lr = wsSource.Range("D1000000").End(xlUp).Row
If lr > 3 Then
    Application.ScreenUpdating = False
    arr = wsSource.Range("A4:E" & lr).Value
    ReDim hArr(1 To UBound(arr), 1 To 3)
    ReDim qArr(1 To UBound(arr), 1 To 1)
    ReDim mArr(1 To UBound(arr), 1 To 1)
    For r = 1 To UBound(arr) Step 1
        qArr(r, 1) = arr(r, 5)
        mArr(r, 1) = arr(r, 4)
        hArr(r, 2) = arr(r, 2)
        hArr(r, 3) = arr(r, 1)
        If WorksheetFunction.Trim(arr(r, 2)) = "" Then
            hArr(r, 1) = hArr(WorksheetFunction.Max(r - 1, 1), 1)
        Else
            hArr(r, 1) = "PX" & Format(arr(r, 2), "00")
        End If
    Next
    fr = wsNX.Range("A65000").End(xlUp).Row + 1
    lr = fr + UBound(arr) - 1
    wsNX.Range("A" & fr & ":C" & lr).Value = hArr
    wsNX.Range("K" & fr & ":K" & lr).Value = mArr
    wsNX.Range("Q" & fr & ":Q" & lr).Value = qArr
    Application.ScreenUpdating = True
End If


End Sub

cám ơn đã giúp đở chúc mọt mgay tốt lành