Sub TaoDH()
Rows("3:3").Select
Selection.Copy
Selection.Insert Shift:=xlDown
Range("B3").Value = ""
Application.CutCopyMode = False
Range("C3").Value = ""
Range("D3").Value = ""
Range("F3").Value = ""
Range("G3").Value = ""
Range("H3").Value = ""
Range("I3").Value = ""
Range("J3").Value = ""
Range("L3").Value = ""
Range("M3").Value = ""
Range("N3").Value = ""
Range("P3").Value = ""
Range("Q3").Value = ""
Range("R3").Value = ""
Range("S3").Value = ""
End Sub
Sub TaoDH()
Rows("3:3").Insert Shift:=xlDown
[A3].Value = [A4].Value: [e3].Value = [E4].Value
[k3].Value = [k4].Value: [o3].Value = [O4].Value
Exit Sub
End SubAnh ơi. Nếu insert như thế này thì các định dạng và công thức ở 1 số ô có đc giữ nguyên ko anh
- Làm như thế này không được anh ạ. Vì như thế các định dạng ô sẽ không đc giữ nguyên, thêm nữa nó sẽ lấy định dạng của dòng phía trên ( A2). Ví dụ như dòng A2 đang là dòng tiêu đề, em có to màu đỏ toàn bộ dòng, khi insert kiểu này thì dòng insert ra cũng sẽ bị tô màu theo.
Sub Sort()
Dim dong_cuoi As Long
dong_cuoi = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Range("A3", "S" & dong_cuoi).Select
Sheet1.Sort.SortFields.Clear
Sheet1.Sort.SortFields.Add Key:=Range("A3"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheet1.Sort
.SetRange Range("A3", "S" & dong_cuoi)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Rows(dong_cuoi).Select
Exit Sub
End SubAnh ơi cho em hỏi 1 tí. Em tạo 1 cái Button khi bấm sẽ chạy đoạn code sau để copy 1 dòng rồi insert nó tại vị trí đó.
Sub TaoDH()
Dim dong_cuoi As Long
dong_cuoi = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Rows(dong_cuoi).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Range("B" & dong_cuoi + 1, "D" & dong_cuoi + 1).Value = ""
Range("F" & dong_cuoi + 1, "J" & dong_cuoi + 1).Value = ""
Range("L" & dong_cuoi + 1).Value = ""
Range("N" & dong_cuoi + 1).Value = ""
Range("P" & dong_cuoi + 1).Value = ""
Range("R" & dong_cuoi + 1).Value = ""
Range("S" & dong_cuoi + 1).Value = ""
Exit Sub
End SubSelection.Insert Shift:=xlDown
Góp ý cho bạn:
cám ơn anh rất nhiều ạ! tại em muốn nó hiện vô textbox để coppy dữ liệu ạ! list box copy k đc tiện!
Cũng tiện mà, Copy từ Array í thôi (Nhờ ListIndex của ListBox)!
Private Sub timinv_Change()
Dim Rng As Range, sRng As Range
Dim lRs As Long, J As Long, W As Integer
Dim MyAdd As String
With Sheets("INV")
lRs = .[B1].CurrentRegion.Rows.Count
Set Rng = .[B1].Resize(lRs)
ReDim Arr(1 To lRs, 1 To 7)
If Len(Me!TimInv.Text) = 4 Then
Set sRng = Rng.Find(Right("000" & Me!TimInv.Text, 7), , xlFormulas, xlWhole)
If sRng Is Nothing Then
MsgBox "Nothing!"
Else
MyAdd = sRng.Address
Do
W = W + 1: Arr(W, 1) = W
Arr(W, 2) = sRng.Offset(, -1).Value: Arr(W, 3) = sRng.Value
Arr(W, 4) = sRng.Offset(, 3).Value: Arr(W, 5) = sRng.Offset(, 4).Value
Arr(W, 6) = sRng.Offset(, 10).Value: Arr(W, 7) = sRng.Offset(, 12).Value
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
Me!lbTim.List = Arr() '<=| <=| <=| <=| <=| '
End If
End If
End With
End Sub
Sub diendulieu()
On Error Resume Next
Sheets(Data).Select
Dim i As Long
If Range("K" & i + 5).Value = "" Then Exit Sub
For i = 1 To Range("K10000").End(xlUp).Row - 5
Range("D" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 2, 0)
Range("E" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 3, 0)
Range("F" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 4, 0)
Range("L" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 6, 0)
Range("O" & i + 5).Value = WorksheetFunction.VLookup(Range("K" & i + 5).Value, Sheet7.Range("B3:G400"), 5, 0)
Range("J" & i + 5).Value = WorksheetFunction.VLookup(Range("P" & i + 5).Value, Sheet7.Range("H3:I400"), 2, 0)
Next
End SubKhoan hãy nói về Code của bạn;
