Lấy dữ liệu tự động sang trang in

[Thanh Null]

Mình có 1 trang dữ liệu thế này



Và đây là sheet in ra phiếu giao hàng cuả mình



Mình muốn là taọ ra một nút sprin theo từng ngày. Khi mà mình nhấn vô thì dữ liệu từ sheet 1 tự chuyển sang sheet 2 theo từng ngày để mình tiện in ấn.
Mong đươc cao thủ giúp đỡ.

 

[snow25]

Mình có 1 trang dữ liệu thế này

View attachment 208599

Và đây là sheet in ra phiếu giao hàng cuả mình

View attachment 208600

Mình muốn là taọ ra một nút sprin theo từng ngày. Khi mà mình nhấn vô thì dữ liệu từ sheet 1 tự chuyển sang sheet 2 theo từng ngày để mình tiện in ấn.
Mong đươc cao thủ giúp đỡ.

Bạn nhập ngày tháng năm vào A4 là được nhé.

Sub intheongay()
Dim arr, arr1
Dim a As Long, b As Long, c As Long, i As Long, j As Long
Dim s As Date
With Sheet1
    arr = .Range("A2:e" & .Range("B" & Rows.Count).End(xlUp).Row).Value
    ReDim arr1(1 To UBound(arr, 1), 1 To 4)
End With
With Sheet2
     s = .Range("A4").Value
     For i = 1 To UBound(arr, 1)
         If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1)
         If CLng(arr(i, 1)) = CLng(s) And arr(i, 2) <> Empty Then
             a = a + 1
             arr1(a, 1) = a
             arr1(a, 2) = arr(i, 2)
             arr1(a, 3) = arr(i, 3)
             arr1(a, 4) = arr(i, 4)
         End If
     Next i
  .Rows("7:18").EntireRow.Hidden = False
  .Range("a7:a18").Resize(, 4).ClearContents
If a Then
   .Range("a7").Resize(a, 4).Value = arr1
   .Rows(a + 9 & ":18").EntireRow.Hidden = True
End If
End With
End Sub

 

[Thanh Null]

Bạn nhập ngày tháng năm vào A4 là được nhé.

Sub intheongay()
Dim arr, arr1
Dim a As Long, b As Long, c As Long, i As Long, j As Long
Dim s As Date
With Sheet1
    arr = .Range("A2:e" & .Range("B" & Rows.Count).End(xlUp).Row).Value
    ReDim arr1(1 To UBound(arr, 1), 1 To 4)
End With
With Sheet2
     s = .Range("A4").Value
     For i = 1 To UBound(arr, 1)
         If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1)
         If CLng(arr(i, 1)) = CLng(s) And arr(i, 2) <> Empty Then
             a = a + 1
             arr1(a, 1) = a
             arr1(a, 2) = arr(i, 2)
             arr1(a, 3) = arr(i, 3)
             arr1(a, 4) = arr(i, 4)
         End If
     Next i
  .Rows("7:18").EntireRow.Hidden = False
  .Range("a7:a18").Resize(, 4).ClearContents
If a Then
   .Range("a7").Resize(a, 4).Value = arr1
   .Rows(a + 9 & ":18").EntireRow.Hidden = True
End If
End With
End Sub

Ví dụ ngày 1 của mình có 20 dòng thì mình sửa thế nào vậy bạn

 

[huonglien1901]

Ví dụ ngày 1 của mình có 20 dòng thì mình sửa thế nào vậy bạn

Thì bạn insert 20 dòng thôi bạn, code vẫn chạy mà bạn.

 

[Thanh Null]

Thì bạn insert 20 dòng thôi bạn, code vẫn chạy mà bạn.

Nhưng bên sheet 2 bị ẩn đi á bạn.

.Rows("7:18").EntireRow.Hidden = False
  .Range("a7:a18").Resize(, 4).ClearContents
If a Then
   .Range("a7").Resize(a, 4).Value = arr1
   .Rows(a + 9 & ":18").EntireRow.Hidden = True

 

[snow25]

Nhưng bên sheet 2 bị ẩn đi á bạn.

.Rows("7:18").EntireRow.Hidden = False
  .Range("a7:a18").Resize(, 4).ClearContents
If a Then
   .Range("a7").Resize(a, 4).Value = arr1
   .Rows(a + 9 & ":18").EntireRow.Hidden = True

Bạn chỉnh bên sheet2 của bạn.Rồi chỉnh code theo là được.Cái số 18 đó tăng thêm.

 

[le_vis]

Bạn nhập ngày tháng năm vào A4 là được nhé.

Sub intheongay()
Dim arr, arr1
Dim a As Long, b As Long, c As Long, i As Long, j As Long
Dim s As Date
With Sheet1
    arr = .Range("A2:e" & .Range("B" & Rows.Count).End(xlUp).Row).Value
    ReDim arr1(1 To UBound(arr, 1), 1 To 4)
End With
With Sheet2
     s = .Range("A4").Value
     For i = 1 To UBound(arr, 1)
         If arr(i, 1) = Empty Then arr(i, 1) = arr(i - 1, 1)
         If CLng(arr(i, 1)) = CLng(s) And arr(i, 2) <> Empty Then
             a = a + 1
             arr1(a, 1) = a
             arr1(a, 2) = arr(i, 2)
             arr1(a, 3) = arr(i, 3)
             arr1(a, 4) = arr(i, 4)
         End If
     Next i
  .Rows("7:18").EntireRow.Hidden = False
  .Range("a7:a18").Resize(, 4).ClearContents
If a Then
   .Range("a7").Resize(a, 4).Value = arr1
   .Rows(a + 9 & ":18").EntireRow.Hidden = True
End If
End With
End Sub

Nhờ Bạn chỉnh lại Code theo cấu trúc bảng đã được sửa lại

 

[snow25]

Nhờ Bạn chỉnh lại Code theo cấu trúc bảng đã được sửa lại

Đây bạn xem.