Implement split with address and copy paste using code

[drop05]

i have two workbooks one that has information put into the other where it will be migrated over to. I can show how it looks below
The way the image k ref is, it will contain an address and the split will go in how x ref image shows it. I listed the cells from the other image for reference. Im using this code in other areas but ran into the issue of this containing address from my source and then my paste file having it broken up
code:

Sub address()
num_ent = Worksheets("path").Range("D10")
For i = 0 To num_ent
For k = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(k + 52 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(k + 52 + i * 351, 7), .Cells(k + 52 + i * 351, lastcol))
End With
If inarr(1, 1) <> "" Then
With Worksheets("Sheet2")
For j = 1 To UBound(inarr, 2)
jj = j - 1
.Range(.Cells(k + 163 + jj * 11, 6 + i), .Cells(k + 163 + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next k
Next i
End Sub

This code takes info from sheet 1 and pastes into sheet2 in the workbook. it checks for instance cell G52 and everything to the right of it and copies those values and pastes them into sheet2 starting at F163 then goes down 11 rows and pastes there then another 11 and so on.
So in this case I am trying to do the same but with a split in the address if possible. Then with num_ent sheet1 jumps 351 cells and it looks exactly the same just at 404 and then does the same but now those values paste into column G and does the same, then goes to H and so on depending on what num_ent is

is there anyway to implement the split on how it is broken up in sheet2 using this code.

 

[DanteAmor]

Try this:

Sub address()
  Dim num_ent As Long, lastcol As Long, nRow As Long
  Dim i As Long, j As Long, jj As Long, k As Long
  Dim inarr As Variant
  
  num_ent = Worksheets("path").Range("D10")
  For i = 0 To num_ent
    For k = 0 To 1
      With Worksheets("Sheet1")
        lastcol = .Cells(k + 52 + i * 351, .Columns.Count).End(xlToLeft).Column
      End With
      If lastcol > 7 Then
        With Worksheets("Sheet1")
          inarr = .Range(.Cells(k + 52 + i * 351, 7), .Cells(k + 52 + i * 351, lastcol))
        End With
        If inarr(1, 1) <> "" Then
          With Worksheets("Sheet2")
            For j = 1 To UBound(inarr, 2)
              jj = j - 1
              nRow = k + 163 + jj * 11
              On Error Resume Next
              .Cells(nRow + 0, 6 + i) = Split(inarr(1, j), ",")(0)
              .Cells(nRow + 1, 6 + i) = Split(inarr(1, j), ",")(1)
              .Cells(nRow + 2, 6 + i) = Split(inarr(1, j), ",")(2)
              .Cells(nRow + 5, 6 + i) = Split(inarr(1, j), ",")(3)
              On Error GoTo 0
              '.Range(.Cells(k + 163 + jj * 11, 6 + i), .Cells(k + 163 + jj * 11, 6 + i)) = inarr(1, j)
            Next j
          End With
        End If
      End If
    Next k
  Next i
End Sub

 

[Fluff]

Duplicate to: Break of an address in a cell

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.