copy transpose

[oleg_v]

hi
i need a help with a macro
attached file with my table
i need a macro will ask for a serial number that in sheet3 column "j" and then copy the entaere row to sheet1 the column b starting with "B2" but without the serial

[lucas]

Here's a stab at it:

see attached example

Option Explicit
Sub Main()

Dim i As Long
Dim sernum As String
sernum = InputBox("Enter the serial number")

For i = TargetRow(Sheets("Sheet3"), 1) - 1 To 2 Step -1
If UCase(Sheets("Sheet3").Cells(i, 10).Value) = sernum Then
Sheets("Sheet3").Rows(i).Copy Sheets("Sheet1").Cells(TargetRow(Sheets("Sheet1"), 1), 1)
Sheets("Sheet1").Columns("J").Delete
End If
Next i

End Sub

Function TargetRow(ByRef ws As Worksheet, ByVal col As Long) As Long
'returns index of first empty row from bottom of sheet
'requires worksheet object and column index
TargetRow = ws.Cells(Rows.Count, col).End(xlUp).Row
If IsEmpty(ws.Cells(TargetRow, col)) Then
'in this case the column is empty
'change targetrow to 2 to move the rows starting on the second row
TargetRow = 1
Else
TargetRow = TargetRow + 1
End If
End Function

[oleg_v]

sorry but
i can not get it to work

[GTO]

I just tried Steve's attachment from #3. Seems to very nicely for me.

[oleg_v]

sorry for my English

i meant to transpose the data to sheet1 starting in "b2" and downwards

[GTO]

Ah, I see now. Maybe:


Option Explicit

Sub TransposeVals()
Dim _
rngLCol_Dest As Range, _
rngSerialFound As Range, _
strSerialNum As String

'// Change sheetname(s) to suit//
With ThisWorkbook.Worksheets("Source")
strSerialNum = InputBox("Enter a serial number to find, as shown below:", _
vbNullString, _
.Range("J2").Value)

If strSerialNum = vbNullString Then Exit Sub

Set rngSerialFound = RangeFound(Range(.Range("J2"), .Cells(Rows.Count, "J")), strSerialNum)
If rngSerialFound Is Nothing Then
MsgBox "Sorry, not found...", 0, vbNullString
Exit Sub
End If


End With

With ThisWorkbook.Worksheets("Dest")
Set rngLCol_Dest = RangeFound(Range(.Range("B2"), .Cells(10, Columns.Count)), _
, , , , xlByColumns)

If rngLCol_Dest Is Nothing Then Set rngLCol_Dest = .Range("A2")

Range(.Cells(2, rngLCol_Dest.Column + 1), .Cells(10, rngLCol_Dest.Column + 1)).Value _
= Application.Transpose(Range(rngSerialFound.Offset(, -9), rngSerialFound.Offset(, -1)).Value)
End With
End Sub

Function RangeFound(SearchRange As Range, _
Optional FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

Hope that helps,

Mark