Insert blank row after each 3 record

[prabir_c]

Hello All,

I want to insert 3 blank row after each Data in a Excel.  following is my data-

I want the data as below format.

This means I have to Copy the full data and  paste it in a excel.  Then Go to last data record and then using a for loop insert a blank row upto A2. Because A1 is the heading.

Please Help. !

[m_woolf · Accepted solution]

See the attached qvw

[tamilarasu]

Hi,

I am using personal edition. So, I am not sure what you have tried. I prepared a sample file from your screenshot and attached the same.

Sub Test()
Dim XLApp, XLDoc, XLSheet 

FileName = "Test.xlsx"
FilePath = ActiveDocument.GetVariable("vVar").GetContent.String

If Right(FilePath,1)<> "\" then
FilePath = FilePath & "\"
End If

File = FilePath & FileName

Set XLApp = CreateObject("Excel.Application") 
XLApp.Visible = False 'True to display the excel
Set XLDoc = XLApp.Workbooks.Add
Set XLSheet= XLDoc.Worksheets("Sheet1")

ActiveDocument.GetSheetObject("TB01").CopyTableToClipboard True
XLSheet.Paste

LastRow = XLSheet.Cells(XLSheet.Rows.Count, 1).End(-4162).Row

For i = LastRow To 3 Step -1
XLSheet.Rows(i).Resize(3).InserT
Next

XLSheet.Range("A1").Select
XLDoc.SaveAs File
XLApp.Application.quit 

Set XLApp = Nothing 
Set XLDoc = Nothing 
Set XLSheet = Nothing 
Msgbox "Exported Sucessfully" & VbNewline & vbNewline & "File path: " & File, vbInformation , "Export"
End Sub

If you have any issues, let me know.

[prabir_c]

Thank You Tamil for your help.. It is working perfectly.

[prabir_c]

Thanks m w fro your help.

[tamilarasu]

Prabir,

Great. I just opened your file and modified few lines of code. Attached the modified file. Hope it helps someone someday.

[#7]

Hi Tamil,

How do you enter a blank row every time the text "Total" is found in the same column?

[tamilarasu]

Hi Clare,

Please find the attached file. Let me know If you have any questions.

[Anil_Babu_Samineni]

Tamil, I don't know what i did wrong here, would you suggest me here. Default when i am trying to hit the Button it goes to Code.

Sub ExcelFile

Dim XLApp, XLDoc, XLSheet 

FileName = "Z:\Test.xlsx"

FilePath = ActiveDocument.GetVariable("vVar").GetContent.String

If Right(FilePath,1)<> "\" then

FilePath = FilePath & "\"

End If

File = FilePath & FileName

Set XLApp = CreateObject("Excel.Application") 

XLApp.Visible = False 'True to display the excel

Set XLDoc = XLApp.Workbooks.Add

Set XLSheet= XLDoc.Worksheets("Sheet1")

ActiveDocument.GetSheetObject("TB01").CopyTableToClipboard True

XLSheet.Paste

LastRow = XLSheet.Cells(XLSheet.Rows.Count, 1).End(-4162).Row

For i = LastRow To 3 Step -1

XLSheet.Rows(i).Resize(3).InserT

Next

XLSheet.Range("A1").Select

XLDoc.SaveAs File

XLApp.Application.quit 

Set XLApp = Nothing 

Set XLDoc = Nothing 

Set XLSheet = Nothing 

Msgbox "Exported Sucessfully" & VbNewline & vbNewline & "File path: " & File, vbInformation , "Export"

End Sub

[tamilarasu]

Hi Anil,

You have to change the macro security setting like in the below picture.

Also I did a minor change in your code.

Sub ExcelFile

Dim XLApp, XLDoc, XLSheet

File = "Z:\Test.xlsx"

Set XLApp = CreateObject("Excel.Application")

XLApp.Visible = False 'True to display the excel

Set XLDoc = XLApp.Workbooks.Add

Set XLSheet= XLDoc.Worksheets("Sheet1")

ActiveDocument.GetSheetObject("TB01").CopyTableToClipboard True

XLSheet.Paste

LastRow = XLSheet.Cells(XLSheet.Rows.Count, 1).End(-4162).Row

For i = LastRow To 3 Step -1

XLSheet.Rows(i).Resize(3).InserT

Next

XLSheet.Range("A1").Select

XLDoc.SaveAs File

XLApp.Application.quit

Set XLApp = Nothing

Set XLDoc = Nothing

Set XLSheet = Nothing

Msgbox "Exported Sucessfully" & VbNewline & vbNewline & "File path: " & File, vbInformation , "Export"

End Sub