Solved: JOB: copying data from one sheet to others

[CHUNKYMONKEY]

I am often stuck performing this one task that I feel can be turned into a macro. I am not good with programming/creating macros, but was able to put this together with the very limited programming knowledge I do have.

Basically I have huge chunks of data that need to be chopped up and put on 6 different spreadsheets. I need to search by entity, and have a range of what the entitiy can fall on. all the entities that fall under the range need to go on one sheet, and so on. If the macro encounters an entitity that doesnt match the range mentioned below, i need to skip that data block. I need to copy the entire block of data that has the entities i mention below. I have sample code that i put together to give you an idea what I am looking for.


I have enclosed a sample of the data that needs the macro to help you visualize my situation.





Sub CopyData()

IF a row in column H Says Entity, and that same row in column I has a VALUE and column F has a cell that says Outstanding Credits,
THEN FOR VALUE,

IF Value = 1000,
THEN copy range of rows (between Entity and Outstanding Credits inclusive) to worksheet labeled ONE

ELSE IF Value = between & including 28001-28036,
THEN copy range of rows (between Entity and Outstanding Credits inclusive) to worksheet labeled TWO

ELSE IF Value = between & including 11001-16006,
THEN copy range of rows (between Entity and Outstanding Credits inclusive) to worksheet labeled THREE

ELSE IF Value = between & including 26810 - 26828,
THEN copy range of rows (between Entity and Outstanding Credits inclusive) to worksheet labeled FOUR

ELSE IF Value = between & including 98500-98759,
THEN copy range of rows (between Entity and Outstanding Credits inclusive) to worksheet labeled FIVE

ELSE IF Value = between & including 28050-28080,
THEN copy range of rows (between Entity and Outstanding Credits inclusive) to worksheet labeled SIX

I want to continue this loop for the remainder of the data , and in between these chunks of data that will be copied to each sheet, I need a blank space to separate each of them so I can see the different chunks clearly

END IF.

END IF

END SUB

[CHUNKYMONKEY]

does anyone have any input on this?

[mdmackillop]

Something like this

Option Explicit

Sub FndEntitiy()
Dim FirstAddress As String
Dim Rng As Range
Dim c As Range, d As Range
Dim tgt As Range
Dim Entity As Long

Set Rng = Sheets("trace318").Columns("H")

With Rng
Set c = .Find("Entity:")
If Not c Is Nothing Then
FirstAddress = c.Address

Do
Entity = c.Offset(, 1)
Set d = .FindNext(c)
If d.Row < c.Row Then Set d = c.Offset(100)
Select Case Entity
Case 1000
Set tgt = Sheets("One").Cells(Rows.Count, 1).End(xlUp).Offset(10)
Rows(c.Row & ":" & d.Row - 1).Copy tgt
Case 28001 To 28036
Set tgt = Sheets("Two").Cells(Rows.Count, 1).End(xlUp).Offset(10)
Rows(c.Row & ":" & d.Row - 1).Copy tgt
Case 1001 To 16006
Set tgt = Sheets("Three").Cells(Rows.Count, 1).End(xlUp).Offset(10)
Rows(c.Row & ":" & d.Row - 1).Copy tgt
'etc.
Case Else
Set tgt = Sheets("Six").Cells(Rows.Count, 1).End(xlUp).Offset(10)
Rows(c.Row & ":" & d.Row - 1).Copy tgt
End Select
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
End Sub

[CHUNKYMONKEY]

thanks mdmackillop, that did the trick! I appreciate your help, i need to learn vba, this stuff is like crack.