Processing in vba

0 votes

I have some data, and the VBA code says that all the rows should be split between the sheets, but one row is still present.

Dim mycell As Range
Dim myrange As Range
Worksheets("sheet2").Range("a1:z10000").Clear
Worksheets("sheet3").Range("a1:z10000").Clear
Worksheets("sheet4").Range("a1:z10000").Clear
Worksheets("sheet5").Range("a1:z10000").Clear
Set myrange = Worksheets("sheet1").Range("a3:a916")
For Each mycell In myrange
If mycell.Value >= 12 Then
If mycell.Value >= 24 Then
mycell.Interior.ColorIndex = 4
mycell.Resize(1, 16).Cut Destination:= _
            Worksheets("sheet2").Range("a1").Offset(Worksheets("sheet2").Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
Else
mycell.Interior.ColorIndex = 5
mycell.Resize(1, 16).Cut Destination:= _
            Worksheets("sheet3").Range("a1").Offset(Worksheets("sheet3").Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
End If
Else
mycell.Interior.ColorIndex = 6
mycell.Resize(1, 16).Cut Destination:= _
            Worksheets("sheet4").Range("a1").Offset(Worksheets("sheet4").Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
End If
Next
Worksheets("sheet2").Columns.AutoFit
Worksheets("sheet3").Columns.AutoFit
Worksheets("sheet4").Columns.AutoFit
End Sub ```
Apr 1, 2023 in Others by Kithuzzz
• 38,010 points
287 views

1 answer to this question.

0 votes

Try this:

Option Explicit
Sub Macro2()

    Dim wb As Workbook, ws As Worksheet, mycell As Range
    Dim n As Long, ci As Long
    
    Set wb = ThisWorkbook
    For n = 2 To 5
        wb.Sheets("Sheet" & n).Range("A1:Z10000").Clear
    Next
    
    Application.ScreenUpdating = False
    For n = 3 To 916
        Set mycell = wb.Sheets("Sheet1").Cells(n, 1)
        ci = 0
        If mycell >= 24 Then
            ci = 4
            Set ws = Sheets("Sheet2")
        ElseIf mycell.Value >= 12 Then
            ci = 5
            Set ws = Sheets("Sheet3")
        ElseIf Len(mycell) > 0 Then ' skip blanks
            ci = 6
            Set ws = Sheets("Sheet4")
        End If
        If ci > 0 Then
            mycell.Interior.ColorIndex = ci
            mycell.Resize(1, 16).Cut _
               Destination:=ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next
    Application.ScreenUpdating = True
    
    For n = 2 To 4
        wb.Sheets("Sheet" & n).Columns.AutoFit
    Next
    MsgBox "Done"

End Sub
answered Apr 1, 2023 by narikkadan
• 63,720 points

Related Questions In Others

0 votes
2 answers
0 votes
1 answer

Language independent way to get "My Documents" folder in VBA Excel 2003

 Hello :)  This code may help you in your ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,670 points
667 views
0 votes
1 answer

Runtime error 438 while importing data in excel from secured website using VBA

Replace With ieDoc.forms(0) .userType.Value = "1" ...READ MORE

answered Sep 23, 2022 in Others by narikkadan
• 63,720 points
774 views
0 votes
1 answer

How to print an Excel Sheet using VBA with Nitro PDF Creator in Excel 2016

you can use the built-in excel facilities ...READ MORE

answered Sep 24, 2022 in Others by narikkadan
• 63,720 points
1,078 views
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
1,006 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
3,371 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 23,260 points
679 views
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,670 points
889 views
0 votes
1 answer
0 votes
1 answer

Excel-VBA - How to identify Target range (more than 1 cell) is deleted in a Worksheet_Change function?

You misunderstand the purpose of the function ...READ MORE

answered Sep 23, 2022 in Others by narikkadan
• 63,720 points
3,365 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP