CODEWITHSUNDEEP
vbaexcelmacros
h.barry
h.barry

Reputation: 27

how to initialise my counter in vba excel

I have a problem with my vba project. My workbook has 4 sheets (Draft, cky, coy and bey), in the sheet "draft i have all my data and i want to reorganise them. the columns "G" of the sheet "draft" contains the values (cky, coy and bey). I want my macro to go through the colums and copy all the cells that have the same value and paste them in their corresponding sheet starting at the cell (A2), for exemple: i want the macro to copy all the data that have "cky" and paste it in the sheet "cky" starting at the cell A2 and so on/ Below you can see what i have done so far:

    Sub MainPower()

Dim lmid As String
Dim srange, SelData, ExtBbFor As String
Dim lastrow As Long
Dim i, j, k As Integer

    lastrow = ActiveSheet.Range("B30000").End(xlUp).Row
    srange = "G1:G" & lastrow
    SelData = "A1:G" & lastrow



    For i = 1 To lastrow
        If InStr(1, LCase(Range("E" & i)), "bb") <> 0 Then
            Range("G" & i).Value = Mid(Range("E" & i), 4, 3)

            ElseIf Left(Range("E" & i), 1) = "H" Then
                Range("G" & i).Value = Mid(Range("E" & i), 7, 3)
            Else
                Range("G" & i).Value = Mid(Range("E" & i), 1, 3)
        End If
    Next i
'Sorting data
    Range("A1").AutoFilter
    Range(SelData).Sort key1:=Range(srange), order1:=xlAscending, Header:=xlYes

'Spreading to the appropriate sheets
    j = 1
    For i = 1 To lastrow


        If Range("G" & i).Value = "CKY" Then


            Sheets("CKY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value

            ElseIf Range("G" & i).Value = "BEY" Then

            Sheets("BEY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value

            ElseIf Range("G" & i).Value = "COY" Then

            Sheets("COY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value

        End If
        j = j + 1

    Next i


End Sub

Thank you to help best regards

Upvotes: 0

Views: 860

Answers (1)

Scott Holtzman
Scott Holtzman

Reputation: 27249

Use this refactored code in the For Loop and it should work for better for you:

For i = 1 To lastrow

    Select Case Sheets("Draft").Range("G" & i).Value

        Case is = "CKY","COY","BEY"

            Dim wsPaste as Worksheet
            Set wsPaste = Sheets(Range("G"& i).Value)

            Dim lRowPaste as Long
            lRowPaste = wsPaste.Range("A" & .Rows.COunt).End(xlup).Offset(1).Row

            wsPaste.Range("A" & lRowPaste & ":E" & lRowPaste).Value = _
             Sheets("Draft").Range("C" & i & ":G" & i).Value

     End Select

Next i

Upvotes: 1

Related Questions