Add 5 rows for each row using VBA Macros

[er725Ashok]

Hi All i have two worksheets from Sheet1 i am copying to Sheet2 which copy data to each row once now i want my data should be look like "To be Version" :
First column willvbe repeated 5 time and other column should be only once

I am using Macros to do this

Current Version
Sheet1
Test1 Test2 Test3
1 1 1
2 2 2
3 3 3

Sheet2
L1 L2 L3
1 1 1
2 2 2
3 3 3



To be Version
Sheet1
Test1 Test2 Test3
1 1 1
2 2 2
3 3 3

Sheet2
L1 L2 L3
1 1 1
1
1
1
1
2 2 2
2
2
2
2
3 3 3
3
3
3
3
3

Function getLastRow(targetSheet As Worksheet, colLetter As String) As Integer
Dim lastRow As Integer
With targetSheet
getLastRow = .Cells(.Rows.count, colLetter).End(xlUp).Row
End With
End Function

Function getColumn(targetSheet As Worksheet, FindWord As String, Optional iRow As Integer = 1) As Integer
Dim iCol As Integer
Dim tmpString As String
For iCol = 1 To getLastColumn(targetSheet, 2)
'targetSheet.Activate
tmpString = VBA.Replace(targetSheet.Cells(iRow, iCol).Value, "", "")
If VBA.InStr(1, VBA.LCase(tmpString), VBA.Replace(VBA.LCase(FindWord), "", "")) Then
getColumn = iCol
Exit Function
End If
Next iCol

End Function




sRow = getLastRow(wsAR, "E") + 1
LRow = getLastRow(wsRaw, "A")

For x = 2 To LRow

Test1 = wsRaw.Cells(x, getColumn(wsRaw, "Test1")).Value
Test2 = wsRaw.Cells(x, getColumn(wsRaw, "Test2")).Value
Test3 = wsRaw.Cells(x, getColumn(wsRaw, "Test3")).Value


For col = 3 To 45 Step 2
If wsRaw.Cells(x, col).Value <> "" Then

wsAR.Range("L1" & sRow).Value = Test1
wsAR.Range("L2" & sRow).Value = Test2
wsAR.Range("L3" & sRow).Value = Test3



End If



Next col
sRow = sRow + 1

Next x

[HaHoBe]

Hi er725Ashok,

welcome to the Forum. Please note that you should wrap your code in Code-Tags for better readability (highlight the code and hit the #). This is requested in Forum Rule #2.

May be this code does what you want:

Please Login or Register  to view this content.

Ciao,
Holger