title: Add 5 rows for each row using VBA Macros
body: <p>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 &quot;To be Version&quot; :
  First column will be repeated 5 time and other column should be only once  i am trying but it does not working ..</p>
  <p>I am using Macros to do this</p>
  <pre><code>    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, &quot;&quot;, &quot;&quot;)
              If VBA.InStr(1, VBA.LCase(tmpString), VBA.Replace(VBA.LCase(FindWord), &quot;&quot;, &quot;&quot;)) Then
                  getColumn = iCol
                  Exit Function
              End If
          Next iCol
          
      End Function
      
  Sub ProcFile()
  Dim wsRaw As Worksheet: Set wsRaw = ThisWorkbook.Sheets(&quot;Sheet1&quot;)
  Dim wsAR As Worksheet: Set wsAR = ThisWorkbook.Sheets(&quot;Sheet2&quot;)
  Dim iRow, x, LRow, sRow, col As Long
  Dim Tes1, Test2, Test3 As String
  
  sRow = getLastRow(wsAR, &quot;E&quot;) + 1
  LRow = getLastRow(wsRaw, &quot;A&quot;)
  
  If wsRaw.Range(&quot;A2&quot;).Value = &quot;&quot; Then MsgBox &quot;Raw Data tab is Empty!!&quot;, vbCritical: Exit Sub
  
  For x = 2 To LRow
          
          Tes1 = wsRaw.Cells(x, getColumn(wsRaw, &quot;Tes1&quot;)).Value
          Test2 = wsRaw.Cells(x, getColumn(wsRaw, &quot;Test2&quot;)).Value
          Test3 = wsRaw.Cells(x, getColumn(wsRaw, &quot;Test3&quot;)).Value
          
         
          
              For col = 3 To 45 Step 2
                  If wsRaw.Cells(x, col).Value &lt;&gt; &quot;&quot; Then
  
                      wsAR.Range(&quot;A&quot; &amp; sRow).Value = Tes1
                      wsAR.Range(&quot;B&quot; &amp; sRow).Value = Test2
                      wsAR.Range(&quot;C&quot; &amp; sRow).Value = Test3
          
                      
                      
                      End If
                 
                  
                  
              Next col
             sRow = sRow + 1
          
  Next x
  
  MsgBox &quot;Done!!&quot;
  
  End Sub
  </code></pre>
  <p>Sheet 1 Raw Data
  <a href="https://i.stack.imgur.com/RE4Vm.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/RE4Vm.png" alt="enter image description here" /></a></p>
  <p>Sheet 2 Data in after macro excution
  <a href="https://i.stack.imgur.com/ZjEAW.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/ZjEAW.png" alt="enter image description here" /></a></p>
  <p>The Data i am getting in my Macro excution:</p>
  <p><a href="https://i.stack.imgur.com/qmFh2.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/qmFh2.png" alt="enter image description here" /></a></p>