Nhờ GPE viết code copy dữ liệu và đổi dấu tất cả các ô trong có chứa dữ liệu đó.

[pham van an]

Nhờ GPE viết code copy dữ liệu và đổi dấu tất cả các ô trong có chứa dữ liệu đó.

 

[sealand]

Bạn có thể tuỳ biến code sau theo ý của mình

Dim Tm, Tm1, Rg As Range, Cl As Range
Dim i, j
Sub Scopy()
 Set Rg = Sheet1.[b8:g18]: Set Cl = Sheet1.[j14]
  Cl.Resize(1000, 100).ClearContents
   For i = 1 To Rg.Columns.Count
    Tm = WorksheetFunction.Transpose(Rg.Columns(i))
      For j = 1 To UBound(Tm)
        If IsNumeric(Tm(j)) And Tm(j) <> 0 Then
         Tm(j) = Tm(j) * -1
          Else
         Tm(j) = "@#@"
        End If
       Next
      Dim kq: kq = Filter(Tm, "@#@", False)
    If UBound(kq) > 0 Then
   Cl.Resize(UBound(kq) + 1) = WorksheetFunction.Transpose(kq)
  Set Cl = Cl.Offset(, 1)
End If: kq = 0: Next
End Sub