Selecting (copying) specific rows up to the last column

[sime2]

Hi,

I have been spinning in circles trying to get any working code for my problem, but nothing has worked so far.
I want to copy certain rows from one sheet e.g. B6 to B63 (including blank rows), from column B to the last column that has values, and paste transpose it to another sheet.

I have a code that copies data till the last row and column, but I really want to specify the last row. In addition, End(xlDown) stops when there is a blank row. My dataset that I want to copy has blank rows in between.
Thanks



Sub test2()
Application.ScreenUpdating = False
Dim sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
Set sh2 = Sheets(2)
Set sh3 = Sheets(3)
Set sh4 = Sheets(4)
With sh3
sh3.Range("B6", Range("B6").End(xlDown).End(xlToRight)).Copy
sh4.Range("C2").PasteSpecial xlPasteValues, Transpose:=True
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

[mana]

.Range("B6", .Cells.SpecialCells(xlLastCell)).Copy

[sime2]

I tried your code, but I am looking for a certain range of rows, as from B6-B63.
With this code I got again all rows, B6 to B183

[mana]

With sh3.Range("B6", sh3.Cells(Rows.Count, "B").End(xlUp))
c = .EntireRow.Find("*", , , , 2, 2).Column
.Resize(, c - .Column + 1).Copy
End With

[sime2]

Where in the code should I put the last row to be included in the selected range? Still it doesnt select the range I want

[mana]

Still it doesnt select the range I want


Sub test()
Dim sh3 As Worksheet
Dim lastCol As Long

Set sh3 = Sheets(3)

With sh3.Range("B6", sh3.Cells(Rows.Count, "B").End(xlUp))
lastCol = .EntireRow.Find("*", , , , 2, 2).Column
.Resize(, lastCol - .Column + 1).Select
End With

End Sub

[paulked]

Not tested, from your original code:



Sub test2()
Application.ScreenUpdating = False
Dim sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
Dim lc As Long
Set sh2 = Sheets(2)
Set sh3 = Sheets(3)
Set sh4 = Sheets(4)
With sh3
.Range(.Cells(6, 2), .Cells(63, .UsedRange.Columns.Count)).Copy
sh4.Range("C2").PasteSpecial xlPasteValues, Transpose:=True
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub