title: Copy paste data based on value (1, 2, or 3) in column A
body: <p>I have Sheet1 which contains multiple columns of data. My macro is supposed to grab specific columns from Sheet1, open up Sheet2, and then paste the data into Sheet2 using other logic. </p>
  
  <p>In column A, I have item numbers that range from 1-4, which have the corresponding Item Name in Column B. The top level item will always be 1 (whole product), but depending on the what creates the final product, it can have multiple item number 2, 3, and 4 which are nested underneath each other. For visual purposes:</p>
  
  <p><code>1 Phone
     2 Battery
       3 Lithium
       3 LithiumX
     2 Camera
       3 Glass
         4 Bulb
         4 Lens</code></p>
  
  <p>Of course in excel, all the numbers will be aligned in column A and the names will aligned in column B. I'm trying to create a VBA code/logic that when the item number is 1, we copy that item name into column B of the new sheet. If item number is 2, we copy that item name into column C of the new sheet, so on and so forth for 3 and 4. The only tricky part is that if the Item name is different for item numbers 2, 3 or 4, the logic needs to catch that copy/paste the correct names. So my end data would look something like this.</p>
  
  <p><code>|A|  B  |    C    |    D    |     E    |
   |1|Phone|         |         |
   |2|Phone| Battery |         |
   |4|Phone| Battery | Lithium |
   |5|Phone| Battery | LithiumX|
   |6|Phone| Battery | LithiumX|
   |7|Phone| Camera  |         |
   |8|Phone| Camera  | Glass   |
   |9|Phone| Camera  | Glass   |  Bulb    |
  </code></p>
  
  <p>My Current VBA Code is below, which doesn't do much but copy and paste the data from sheet1 to sheet2:</p>
  
  <p>`</p>
  
  <pre><code>cls = Array("A1", "B1")
  
  Set sh1 = Sheets("Sheet1")
  'Set sh2 = ThisWorkbook.Sheets(2)
  Set sh2 = Worksheets.Add(Type:=xlWorksheet, After:=Application.ActiveSheet)
  On Error Resume Next
  sh2.Name = "Test"
  On Error GoTo 0
  
  'Clear sheet 2
  sh2.Cells.Clear
  
  'cut specific headers from Sheet 1 and paste to sheet 2
  With sh2
      LR = WorksheetFunction.Max(1, .Range("A" &amp; Rows.Count).End(xlUp).Row)
      For n = LBound(cls) To UBound(cls)
          Me.Range(cls(n)).Copy Destination:=.Cells(LR, n + 1)
      Next n
  End With
  
  Let lrow1 = sh1.Range("A65356").End(xlUp).Row
  
  For i = 2 To lrow1
      Let lrow3 = sh2.Range("A65356").End(xlUp).Row
          sh2.Cells(lrow3 + 1, 1) = sh1.Cells(i, 1)
          sh2.Cells(lrow3 + 1, 2) = sh1.Cells(i, 2)
  
  Next i
  </code></pre>
  
  <p>`
  Any help would be appreciated!</p>