Solved: copy ranges (tables) separated for separate tabs

[marreco]

Hi.
how to find small tables and copy each for a guide?

I created the tabs manually, the code has to pick up the tab master data, and create tebela 1 for the first intervalor with data, and so

[mancubus]

hi marreco.
try this.
it assumes tables are seperated with at least 1 blank row.


Sub FindMultipleInstancesAddWsCopyFoundCellCurrentRegion()
'adopted from: http://www.cpearson.com/excel/FindAll.aspx

Dim LookUpRng As Range, LastCell As Range, FoundCell As Range
Dim FirstAddress As String, SearchStr As String, TabName As String

SearchStr = "TABELA"

Set LookUpRng = Worksheets("Master").UsedRange
With LookUpRng
Set LastCell = .Cells(.Cells.Count)
Set FoundCell = .Find(What:=SearchStr, _
after:=LastCell, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
End With

If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
Do
TabName = Mid(FoundCell, InStr(1, FoundCell, SearchStr))
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = TabName
FoundCell.CurrentRegion.Copy ActiveSheet.Cells(1, 1)
Set FoundCell = LookUpRng.FindNext(FoundCell)
Loop Until FoundCell.Address = FirstAddress
End If

End Sub

[marreco]

Hi.

I'm very glad you help me!:rotlaugh:

very perfect!!

thank you very much!!

[mancubus]

you are welcome.

and thanks for marking the thread as "solved".