Copy Horizontal and paste vertically

[BombSheels]

Hello Experts,
I've been trying to modify this macro i've found in the forum.
In my source file, i need to copy data from Column BH-BK and paste the data in another sheet vertically, to be paste in column BK.
i have more than 200 rows to be copied

Here's my code:
Sub Sin3()
Dim Ary As Variant, Nary As Variant
Dim r As Long, nr As Long

Ary = Sheets("COPY DATA").Range("BH3").CurrentRegion.Value2
ReDim Nary(1 To UBound(Ary) * (UBound(Ary, 2) + 1), 1 To 1)

For r = 3 To UBound(Ary)
nr = nr + 1
Nary(nr, 1) = Ary(r, 1): Nary(nr + 1, 1) = Ary(r, 2): Nary(nr + 2, 1) = Ary(r, 3): Nary(nr + 3, 1) = Ary(r, 4)
nr = nr + 3
Next r
Sheets("PENETRATE").Range("BK8").Resize(nr).Value = Nary
End Sub

COPY DATA SHEET

PENETRATE SHEET

 

[Alex Blakenburg]

You only talk about copying to column BK but it would appear from your image that columns BI & BJ should contain rows 1 and 2 respectively.
Your percentages in Column BJ seem to be out of alignment with the values in BK.

Should the code be filling in columns BI & BJ as well ?
If so will Column BI just repeat 1-4 for each group ?

 

[BombSheels]

You only talk about copying to column BK but it would appear from your image that columns BI & BJ should contain rows 1 and 2 respectively.
Your percentages in Column BJ seem to be out of alignment with the values in BK.

Should the code be filling in columns BI & BJ as well ?
If so will Column BI just repeat 1-4 for each group ?

Hello Alex,
Thank you
Column BI-BJ are fixed till row 1000. So copying only from DATA SHEET is from Row 3 downward to be paste in BK in PENETRATE sheet.

 

[Alex Blakenburg]

OK I will have a look but you need to be sure that the below is not a problem:

 

[BombSheels]

OK I will have a look but you need to be sure that the below is not a problem:

View attachment 70385

i think i will just format the column in PENETRATE sheet to match the source file

 

[Alex Blakenburg]

See if this works for you:

Sub Sin3_Transpose()
    Dim Ary As Variant, Nary As Variant
    Dim r As Long, nr As Long, col As Long
    Dim shtCopyData As Worksheet
    Dim shtPaste As Worksheet
    Dim rngPaste As Range
    Dim lastRowCopy As Long
      
    Set shtCopyData = Worksheets("COPY DATA")
    Set shtPaste = Worksheets("PENETRATE")
    Set rngPaste = shtPaste.Range("BK8")
    
    lastRowCopy = shtCopyData.Cells(Rows.Count, "BH").End(xlUp).Row
    
    Ary = shtCopyData.Range("BH3:BK" & lastRowCopy).Value2
    ReDim Nary(1 To UBound(Ary) * (UBound(Ary, 2) + 1), 1 To 1)
    
    For r = 1 To UBound(Ary)
        For col = 1 To UBound(Ary, 2)
            nr = nr + 1
            Nary(nr, 1) = Ary(r, col)
        Next col
    Next r
    rngPaste.Resize(nr).Value = Nary
End Sub

 

[BombSheels]

See if this works for you:

Sub Sin3_Transpose()
    Dim Ary As Variant, Nary As Variant
    Dim r As Long, nr As Long, col As Long
    Dim shtCopyData As Worksheet
    Dim shtPaste As Worksheet
    Dim rngPaste As Range
    Dim lastRowCopy As Long
     
    Set shtCopyData = Worksheets("COPY DATA")
    Set shtPaste = Worksheets("PENETRATE")
    Set rngPaste = shtPaste.Range("BK8")
   
    lastRowCopy = shtCopyData.Cells(Rows.Count, "BH").End(xlUp).Row
   
    Ary = shtCopyData.Range("BH3:BK" & lastRowCopy).Value2
    ReDim Nary(1 To UBound(Ary) * (UBound(Ary, 2) + 1), 1 To 1)
   
    For r = 1 To UBound(Ary)
        For col = 1 To UBound(Ary, 2)
            nr = nr + 1
            Nary(nr, 1) = Ary(r, col)
        Next col
    Next r
    rngPaste.Resize(nr).Value = Nary
End Sub

It works perfectly!!!!! Thank you so much Alex

 

[Alex Blakenburg]

You're welcome. Glad I could help.