Copy rows to different sheets based on multiple criteria excel VBA macro

[Jyotirmaya]

Sub CopyToSheets()

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long
Dim lastrow2 As Long
Dim rownum As Long
Dim ws2name As String

Set ws = Sheets("RAW DATA")
lastrow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
For rownum = 2 To lastrow
    Select Case ws.Cells(rownum, 8)
      Case "A"
         ws2name = "A"

       Case Else
        ws2name = ws.Cells(rownum, 5)
    End Select
    Set ws2 = Sheets(ws2name)
    lastrow2 = ws2.Cells(ws2.Rows.Count, "E").End(xlUp).Row
    ws.Rows(rownum).Copy ws2.Rows(lastrow2 + 1)
Next rownum
End Sub

election ed exp.xlsm
	A	B	C	D	E	F	G	H
1
2	1	100	15	1	A	1	1	1
3	2	100	45	2	A	2	2	2
4	3	100	47	3	A	3	3	3
5	4	100	52	4	A	4	4	4
6	5	100	103	5	A	5	5	5
7	6	100	308	6	A	6	6	6
8	7	100	401	7	A	7	7	7
9	8	100	55	8	A	8	8	8
10	9	100	444	9	A	9	9	9
11	10	100	555	10	A	10	10	10
12	11	100	666	11	A	11	11	11
13	12	100	777	12	A	12	12	12
14	13	100	888	13	A	13	13	13
15	14	100	999	14	A	14	14	14
16	15	100	555	15	A	15	15	15
17	16	100	666	16	A	16	16	16
18	17	100	777	17	A	17	17	17
19	18	100	888	18	A	18	18	18
20	19	100	999	19	A	19	19	19
RAW DATA

I am using the above code to copy data from RAW DATA sheet to other sheets.
In column E, I have "A" is there.
but now I want that for example in case of text "A" in colum E, if Column B=100 & column C value range rows from 1 to 500 then it will copy those rows data to a new sheet A1 and if column B=100 and cell value range from 501-1000 then it will copy those rows data to a new sheet A2
I Dont want the data to copy in Sheet A, the data should be directly copied into A1 & A2 Sheets.
What should be the change in the code ?? please help.

In the above case I want first 10 rows to copy in A1 sheet and 11-20 rows into A2 sheet.

 

[Fluff]

Do sheets A1 & A2 already exist, or do they need to be created?

 

[Jyotirmaya]

Do sheets A1 & A2 already exist, or do they need to be created?

I have manually already created the sheets A1 & A2

 

[Fluff]

Is there any data on those two sheets? If so should that data be cleared, or the new data add below the existing data?

 

[Jyotirmaya]

Is there any data on those two sheets? If so should that data be cleared, or the new data add below the existing data?

No there aren't any data. The sheets are newly just created

 

[Fluff]

Ok, how about

Sub CopyToSheets()

Dim ws As Worksheet
Dim lastrow As Long
Dim rownum As Long

Set ws = Sheets("RAW DATA")
lastrow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
For rownum = 2 To lastrow
   If ws.Cells(rownum, 5) = "A" And ws.Cells(rownum, 2) = 100 Then
      Select Case ws.Cells(rownum, c)
         Case 1 To 500
            ws.Rows(rownum).Copy Sheets("A1").Cells(Rows.Count, 5).End(xlUp).Offset(1, -4)
         Case 501 To 1000
            ws.Rows(rownum).Copy Sheets("A2").Cells(Rows.Count, 5).End(xlUp).Offset(1, -4)
      End Select
   End If
Next rownum
End Sub

 

[Jyotirmaya]

Ok, how about

Sub CopyToSheets()

Dim ws As Worksheet
Dim lastrow As Long
Dim rownum As Long

Set ws = Sheets("RAW DATA")
lastrow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
For rownum = 2 To lastrow
   If ws.Cells(rownum, 5) = "A" And ws.Cells(rownum, 2) = 100 Then
      Select Case ws.Cells(rownum, c)
         Case 1 To 500
            ws.Rows(rownum).Copy Sheets("A1").Cells(Rows.Count, 5).End(xlUp).Offset(1, -4)
         Case 501 To 1000
            ws.Rows(rownum).Copy Sheets("A2").Cells(Rows.Count, 5).End(xlUp).Offset(1, -4)
      End Select
   End If
Next rownum
End Sub

Thank you for your help, but I got error message that - run time error 1004 application defined or object defined error
and when I clicked on debug it showed in yellow

     Select Case ws.Cells(rownum, c)

what should be the chage ??

 

[Fluff]

Oops either change the c to "C" or to 3

 

[Jyotirmaya]

Oops either change the c to "C" or to 3

Thank you so much dear

 

[Fluff]

You're welcome & thanks for the feedback.