Viết code copy dữ liệu (1 người xem)

[lhthai]

Hiện tại mình có file data sau
Tại sheet data mình copy dữ liệu qua sheet 2 bằng thao tác tay hàng ngày
chẳng hạn như tại cột J của sheet data mình loc filter chon blanks sau đó copy từ cột qua sheet 2
cứ làm liên tục cho tới cuối.
bạn nào có cách nào làm nhanh hơn không chỉ mình nha

 

[Quang_Hải]

Hiện tại mình có file data sau
Tại sheet data mình copy dữ liệu qua sheet 2 bằng thao tác tay hàng ngày
chẳng hạn như tại cột J của sheet data mình loc filter chon blanks sau đó copy từ cột qua sheet 2
cứ làm liên tục cho tới cuối.
bạn nào có cách nào làm nhanh hơn không chỉ mình nha

Nhìn file cũng hơi hoa mắt nhưng cũng viết thí thí coi có trúng không

Sub LocQH()
Dim data(), i, j, x, k, kq(1 To 65536, 1 To 8)
With Sheets("Data")
   data = .Range(.[B4], .[B65536].End(3)).Resize(, 153).Value
End With
For j = 9 To UBound(data, 2)
   For i = 7 To UBound(data)
       If data(i, j) > 0 Then
         k = k + 1
         For x = 1 To 5
            kq(k, x) = data(x, j)
         Next
         kq(k, 6) = data(i, 1)
         kq(k, 7) = data(i, 2)
         kq(k, 8) = data(i, j)
       End If
   Next
Next
Sheets("Sheet2").[J3].Resize(k, 8) = kq
End Sub

 

[lhthai]

Hay quá cám ơn anh nhiều nha

 

[lhthai]

Nhìn file cũng hơi hoa mắt nhưng cũng viết thí thí coi có trúng không

Sub LocQH()
Dim data(), i, j, x, k, kq(1 To 65536, 1 To 8)
With Sheets("Data")
   data = .Range(.[B4], .[B65536].End(3)).Resize(, 153).Value
End With
For j = 9 To UBound(data, 2)
   For i = 7 To UBound(data)
       If data(i, j) > 0 Then
         k = k + 1
         For x = 1 To 5
            kq(k, x) = data(x, j)
         Next
         kq(k, 6) = data(i, 1)
         kq(k, 7) = data(i, 2)
         kq(k, 8) = data(i, j)
       End If
   Next
Next
Sheets("Sheet2").[J3].Resize(k, 8) = kq
End Sub

Anh có thể tạo hộp thoại chọn sheet cần lọc giống file ABC của em được không

 

[Quang_Hải]

Anh có thể tạo hộp thoại chọn sheet cần lọc giống file ABC của em được không

Private Sub CommandButton1_Click()
Dim data(), i, j, x, k, kq(1 To 65536, 1 To 8)
Dim shname As String
shname = InputBox("Nhap ten Sheet")
If Len(shname) = 0 Then Exit Sub
With Sheets(shname)
   data = .Range(.[B3], .[B65536].End(3)).Resize(, 153).Value
End With
For j = 9 To UBound(data, 2)
   For i = 8 To UBound(data)
       If data(i, j) > 0 Then
         k = k + 1
         For x = 1 To 5
            kq(k, x) = data(x, j)
         Next
         kq(k, 6) = data(i, 1)
         kq(k, 7) = data(i, 2)
         kq(k, 8) = data(i, j)
       End If
   Next
Next
Sheets("Sheet2").[B3].Resize(k, 8) = kq
End Sub