Transpose and separating worksheet based on Input box name

[ryll]

Hi, this are my codes. It allows me to return a multiple row of the
selected "Region" i entered in the InputBox eg, Europe in another
worksheet named Region.

However i would like them to be separated in different worksheet. for
eg, when the user type in the region -Europe in the input box, a new
worksheet Europe will be created with the information taken from the
rows of all Europe information in raw. I would also like it to be
transpose. Is it possible? Thanks!


Sub getRegion()
Dim fnd As String
Dim fndRng As Range
Dim eRow As Long
Dim ff As String

fnd = InputBox("Enter a Region")

If fnd <> "" Then
With Sheets("raw").Cells
Set fndRng = .Find(fnd)

If Not fndRng Is Nothing Then
ff = fndRng.Address
Do
eRow = Sheets("Region").Cells(Rows.Count, 1). _
End(xlUp).Row + 1
fndRng.EntireRow.Copy Sheets("Region").Cells(eRow,
1)
Set fndRng = .FindNext(fndRng)
Loop Until ff = fndRng.Address
End If
End With
End If

End Sub

 

[Tom Ogilvy]

Assuming the code you posted copies what you want, then these additions
should get you started

Sub getRegion()
Dim fnd As String
Dim fndRng As Range
Dim eRow As Long
Dim ff As String
Dim sh as Worksheet
fnd = InputBox("Enter a Region")

If fnd <> "" Then
set sh = worksheets.Add(after:=worksheets(worksheets.count))
sh.Name = fnd & "_Data"
col = 1
With Sheets("raw").Cells
Set fndRng = .Find(fnd)

If Not fndRng Is Nothing Then
ff = fndRng.Address
Do
eRow = Sheets("Region").Cells(Rows.Count, 1). _
End(xlUp).Row + 1
fndRng.EntireRow.Copy
sh.cells(1,col).PasteSpecial Transpose:=True
col = col + 1
Set fndRng = .FindNext(fndRng)
Loop Until ff = fndRng.Address
End If
End With
End If

End Sub