Combine multiple Sub()

[drop05]

Hello I am trying to see if there is a way to combine these sub instead of having to do them separate. I want them together because I am wanting to add so the user selects two files (one that has sheet1, the other has sheet2) sheet1 is the copy file from and sheet2 is the paste in landing spots.
Please notice that in each sub the numbers for last col, 52, changes to 52 and also in .range the number 163 changes to 164 in the second sub and in the third sub it changes as well by adding one, i have others in which they change in those numbers as well. Any help would be grateful!

Sub name()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(52 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(52 + i * 351, 7), .Cells(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(163 + jj * 11, 6 + i), .Cells(163 + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next i
End Sub

This brings in the address

Sub address()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(53 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(53 + i * 351, 7), .Cells(53 + 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(164 + jj * 11, 6 + i), .Cells(164 + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next i
End Sub

Sub ID()
For i = 0 To 1
With Worksheets("Sheet1")
lastcol = .Cells(54 + i * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells(54 + i * 351, 7), .Cells(54 + 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(165 + jj * 11, 6 + i), .Cells(165 + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next i
End Sub

 

[kvsrinivasamurthy]

Pl try this code. I have changed your code as required.

Sub Consolidate()
For i = 0 To 5
With Worksheets("Sheet1")
lastcol = .Cells((52 + Int(i / 2)) + (i Mod 2) * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Workshee5s("Sheet1")
inarr = .Range(.Cells((52 + Int(i / 2)) + (i Mod 2) * 351, 7), .Cells((52 + Int(i / 2)) + (i Mod 2) * 351, lastcol))
End With
If inarr(1, 1) <> "" Then
With Worksheets("Sheet2")
For j = 1 To UBound(inarr, 2)
jj = j - 1
.Range(.Cells((163 + Int(i / 2)) + jj * 11, 6 + i), .Cells((163 + Int(i / 2)) + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next i
End Sub

 

[drop05]

Pl try this code. I have changed your code as required.

Sub Consolidate()
For i = 0 To 5
With Worksheets("Sheet1")
lastcol = .Cells((52 + Int(i / 2)) + (i Mod 2) * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Workshee5s("Sheet1")
inarr = .Range(.Cells((52 + Int(i / 2)) + (i Mod 2) * 351, 7), .Cells((52 + Int(i / 2)) + (i Mod 2) * 351, lastcol))
End With
If inarr(1, 1) <> "" Then
With Worksheets("Sheet2")
For j = 1 To UBound(inarr, 2)
jj = j - 1
.Range(.Cells((163 + Int(i / 2)) + jj * 11, 6 + i), .Cells((163 + Int(i / 2)) + jj * 11, 6 + i)) = inarr(1, j)
Next j
End With
End If
End If
Next i
End Sub

Thank you for the response, it works partials of the way, i do have some concerns.
Some of the pasting values are not going to the correct landing spots.
I have below a screen shot of the names going from left to right pasting correct for the iterations, however the address and ID did not go to the correct spot, they should go where i change the cell background to green and red text and you can see where they did land. where in the code should i fix this at?

 

[kvsrinivasamurthy]

I have corrected the code. Pl try.

Sub Consolidate()
For i = 0 To 5
K = i Mod 2
With Worksheets("Sheet1")
lastcol = .Cells((52 + Int(i / 2)) + (i Mod 2) * 351, .Columns.Count).End(xlToLeft).Column
End With
If lastcol > 7 Then
With Worksheets("Sheet1")
inarr = .Range(.Cells((52 + Int(i / 2)) + (i Mod 2) * 351, 7), .Cells((52 + Int(i / 2)) + (i Mod 2) * 351, lastcol))
End With
If inarr(1, 1) <> "" Then
With Worksheets("Sheet2")
For j = 1 To UBound(inarr, 2)
jj = j - 1
.Range(.Cells((163 + Int(i / 2)) + jj * 11, 6 + (i Mod 2)), .Cells((163 + Int(i / 2)) + jj * 11, 6 + (i Mod 2))) = inarr(1, j)
Next j
End With
End If
End If
Next i
End Sub