Các bác giúp tự động Insert row trong một vùng chọn (2 người xem)

[thao_tedi]

Kính chào các bác. Em có một bảng dữ liệu rất lớn với nhiều dòng. Bây giờ e muốn mỗi bảng dữ liệu tự động sau mỗi dòng sẽ có môt dòng trống (insert rown từ đầu đến cuối cho mỗi dòng). Nếu làm tay insert từng dòng một thì mất thời gian quá. Các bác giúp em lập bằng VBA được không ạ? Xin chân thành cảm ơn.

 

[ptlong04x1]

Bạn dùng thử code sau :

Sub InS()
    Dim i As Long
    With ActiveSheet.UsedRange
        For i = 1 To .Rows.Count
            .Cells(1).Offset(2 * i - 1).EntireRow.Insert
        Next i
    End With
End Sub

 

[thao_tedi]

Cảm ơn bác nhiều. Chúc bác và gia đình mạnh khỏe và gặp nhiều may mắn!

 

[huyxc]

[h=2]

nho rut gon ma VBA nhat ky[/h]

Chào Anh!
Mình mới tập viết VBA
Mình có đoạn mã sau cần rút gọn lại
Thấy ndu96081631 có những bài viết rất hay mình xin chỉ giáo

1. vào sheet NhatKyhs
- nhập giá trị 1 vào ô A1
- chọn vùng copy chuyển qua
2. vào sheet NK
- Dán giá trị vừa copy vào ô A2 ( dán giá trị không định dạng)
=> xong 1 lần
---------
3. vào sheet NhatKyhs
- nhập giá trị 2 vào ô A1
- chọn vùng copy chuyển qua
2. vào sheet NK
- Dán giá trị vừa copy vào ô A9 ( dán giá trị không định dạng)
=> xong 2 lần
---------
Quá trình này lặp lại nhiều lần cho đến hết



Sub XoatrangNK()
'
' Macro1 Macro
' Macro recorded 07/01/2013 by Mien Tay
'

'
Sheets("NK").Select
Columns("A").Select
Selection.ClearContents
Range("A1").Select
Rows("1:1").RowHeight = 25
ActiveCell.FormulaR1C1 = "NHÂT KÝ THI CÔNG"
Selection.Font.Bold = True
Range("A1:O1").Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub


Sub copynhatky1to200()
'
' copynhatky1 Macro
' Pham xuan Huy
'

'
'---------------------
Call XoatrangNK
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "1"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "2"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "3"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "4"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "5"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a30").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "6"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a37").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub​

Tập tin đính kèm

• 
  Rut gon VBA.zip (163.5 KB, 0 lần tải)

 

[ChanhTQ@]

[thongbao] Nên xem kỹ & tuân thủ nội qui[/thongbao]

 

[Quang_Hải]

nho rut gon ma VBA nhat ky

Chào Anh!
Mình mới tập viết VBA
Mình có đoạn mã sau cần rút gọn lại
Thấy ndu96081631 có những bài viết rất hay mình xin chỉ giáo

1. vào sheet NhatKyhs
- nhập giá trị 1 vào ô A1
- chọn vùng copy chuyển qua
2. vào sheet NK
- Dán giá trị vừa copy vào ô A2 ( dán giá trị không định dạng)
=> xong 1 lần
---------
3. vào sheet NhatKyhs
- nhập giá trị 2 vào ô A1
- chọn vùng copy chuyển qua
2. vào sheet NK
- Dán giá trị vừa copy vào ô A9 ( dán giá trị không định dạng)
=> xong 2 lần
---------
Quá trình này lặp lại nhiều lần cho đến hết



Sub XoatrangNK()
'
' Macro1 Macro
' Macro recorded 07/01/2013 by Mien Tay
'

'
Sheets("NK").Select
Columns("A").Select
Selection.ClearContents
Range("A1").Select
Rows("1:1").RowHeight = 25
ActiveCell.FormulaR1C1 = "NHÂT KÝ THI CÔNG"
Selection.Font.Bold = True
Range("A1:O1").Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub


Sub copynhatky1to200()
'
' copynhatky1 Macro
' Pham xuan Huy
'

'
'---------------------
Call XoatrangNK
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "1"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "2"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "3"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "4"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a23").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "5"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a30").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'---------------------
Sheets("NhatKyhs").Select
ActiveCell.FormulaR1C1 = "6"
Range("listnhatky").Select
Selection.Copy
Sheets("NK").Select
Range("a37").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub​

Tập tin đính kèm

• 
  Rut gon VBA.zip (163.5 KB, 0 lần tải)

http://www.giaiphapexcel.com/forum/showthread.php?69021-In-hóa-đơn-bằng-VBA

Để tìm xem bài này post bao nhiêu chỗ