Loop

[Amjtoo]

Hi all,

I have an excel sheet where there are data with empty rows in between.
My aim is to cut a range of data based on a cell value in column A and paste the data in a new worksheet by creating one.
Eg- if there is the word "name" in any row in col A then from that cell it will select xltoright and xldown , cut the entire data n paste in a new worksheet in the same file.
Again it will come back to the original sheet n scout through the rows to find cell with "name" and do the same operation but only paste in another new worksheet.
The data is not continuous so I can't run do until isempty loop

Kindly suggest if it's possible to achieve it by coding n if yes,how?

 

[Amjtoo]

View attachment 13805

Are those cells, in the image above, highlighted in red, always empty?

Not all the red highlighted cells are empty..there are data where I have put A,B,C n other alphabets...but few cells are empty which I have kept as blank

 

[DanteAmor]

if there is the word "name" in any row in col A then from that cell it will select xltoright and xldown , cut the entire data n paste in a new worksheet in the same file.

Try this

Sub LoopCells()
  Dim r As Range, f As Range, cell As String
  Application.ScreenUpdating = False
  Set r = Range("A:A")
  Set f = r.Find("Name", , xlValues, xlWhole)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      Range(f, f.End(2).End(4)).Copy
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Paste
      Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> cell
  End If
  Application.CutCopyMode = False
End Sub

 

[Amjtoo]

Try this

Sub LoopCells()
  Dim r As Range, f As Range, cell As String
  Application.ScreenUpdating = False
  Set r = Range("A:A")
  Set f = r.Find("Name", , xlValues, xlWhole)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      Range(f, f.End(2).End(4)).Copy
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Paste
      Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> cell
  End If
  Application.CutCopyMode = False
End Sub

Okay I will try this

 

[Amjtoo]

Try this

Sub LoopCells()
  Dim r As Range, f As Range, cell As String
  Application.ScreenUpdating = False
  Set r = Range("A:A")
  Set f = r.Find("Name", , xlValues, xlWhole)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      Range(f, f.End(2).End(4)).Copy
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Paste
      Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> cell
  End If
  Application.CutCopyMode = False
End Sub

Try this

Sub LoopCells()
  Dim r As Range, f As Range, cell As String
  Application.ScreenUpdating = False
  Set r = Range("A:A")
  Set f = r.Find("Name", , xlValues, xlWhole)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      Range(f, f.End(2).End(4)).Copy
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Paste
      Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> cell
  End If
  Application.CutCopyMode = False
End Sub

Hi DanteAmor,

Thanks a lot for your help.. the code is working fine.
Appreciate your time and effort.
If possible please help me out with another issue that am facing.

I am filtering a set of about 1400 rows(with header) based on 3 column values. Then m trying to delete the hidden rows. But the last 16 rows are getting retained though they don't satisfy the 3 conditions.

Looking forward to your solution

 

[DanteAmor]

Sounds like it's another problem than this thread. Create a new thread, that way you can receive more opportunities for help, don't forget to give examples of your data and the result you need.