copying a column to another worksheet but each row should contain only 10 columns

[Davidex]

Hi,
I recently posted a query but it was more like a project. I am solving one by one. I have already sorted column A to C based on column A values. Now I need to copy and paste column A in Sheet2. But in Sheet2 I want each row should contain only 10 values, the remaining values should go into the first 10 columns of Row2 and so on. Any Ideas? Thanks!

 

[sheetspread]

You can use the mod (remainder) function in either the worksheet or VBA. You can also use a for/next loop with step size 10 to copy the range and transpose.

 

[Davidex]

You can use the mod (remainder) function in either the worksheet or VBA. You can also use a for/next loop with step size 10 to copy the range and transpose.

Thanks Sheetspread. As I know the number of rows in Column A, I would prefer to use the second method you suggested. But my problem is VBA code to select the destination range. Appreciate the help.

 

[sheetspread]

If I have A1:A80 numbered 1 to 80, and run this:

Sub transpevery10()
Dim x As Integer
Dim lr As Integer
lr = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To lr Step 10
Range("A" & x).Resize(10).Copy
Range("B" & (x + 9) / 10).PasteSpecial Transpose:=True
Next
End Sub

In B1:K8 will print 1-10,11-20, etc.

 

[Davidex]

Thanks Sheetspread, works as you said. Now I need to rework the code to paste in sheet2. Also I have to make sure the Header in Column A is not copied. Your fast and elegant answer is motivation for me to do something on my own.

 

[Davidex]

If I have A1:A80 numbered 1 to 80, and run this:

Sub transpevery10()
Dim x As Integer
Dim lr As Integer
lr = Cells(Rows.Count, 1).End(xlUp).Row
For x = 1 To lr Step 10
Range("A" & x).Resize(10).Copy
Range("B" & (x + 9) / 10).PasteSpecial Transpose:=True
Next
End Sub

In B1:K8 will print 1-10,11-20, etc.

Hi sheetspread,
I just modified your code so that my header cell is not copied. Works fine. Please have a look and see whether there can be a better way. Now I am onto pasting into another sheet. Thanks!

Sub mytranspevery10()
Dim x As Integer
Dim y As Integer
Dim lr As Integer
lr = Cells(Rows.Count, 1).End(xlUp).Row
y = 1
For x = 2 To lr Step 10
If x > 10 Then
    y = x - 1
End If
Range("A" & x).Resize(10).Copy
If y = 1 Then
    Range("B" & (y + 9) / 10).PasteSpecial Transpose:=True
Else
    Range("B" & (y + 9) / 10).PasteSpecial Transpose:=True
End If
Next
End Sub

 

[Davidex]

Hi,
To copy into another sheet, I changed the code

Range("B" & (y + 9) / 10).PasteSpecial Transpose:=True

To

DestSheet.Range("A" & (y + 9) / 10).PasteSpecial Transpose:=True

Now onto making all the copied cells into hyperlinks.

 

[sheetspread]

If you're just skipping one header the code can be changed with fewer lines

 

[Davidex]

If you're just skipping one header the code can be changed with fewer lines

I am interested in knowing how. I introduced the variable "y" only for that.

Sub myCopyPaste()
Dim x As Integer
Dim y As Integer
Dim lr As Integer
Dim DestSheet As Worksheet
Set DestSheet = Sheets("Sheet2")
Worksheets("Sheet1").Activate
lr = Cells(Rows.Count, 1).End(xlUp).Row
y = 1
For x = 2 To lr Step 10
If x > 10 Then
    y = x - 1
End If
Worksheets("Sheet1").Range("A" & x).Resize(10).Copy
If y = 1 Then
    DestSheet.Range("A" & (y + 9) / 10).PasteSpecial Transpose:=True
Else
    DestSheet.Range("A" & (y + 9) / 10).PasteSpecial Transpose:=True
End If
Next
End Sub

To update, I gave up the idea of making every pasted cell as hyperlink. I am using the following code to reach the next Sheet:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Worksheets("Sheet3").Activate
End Sub

Thanks for your time and help.

 

[sheetspread]

How many headers are there? Can you show me a sample of the structure? Are you trying to copy each row to a new sheet?