Macro to copy parts of data from a row to specific location based on a value

[galbatrox9]

Hi Guys,

I have a raw excel sheet with rows of data that all have an account number in he first row. And i want to transfer those rows of data to a dedicated sheet per the account number. Now here is the thing. This i got with this code

If (InStr(1, Cells(i, 1).Value, "55711") > 0)  Then        Rows(i).Copy
        srow = ThisWorkbook.Sheets("DeltaMan").Range("A65536").End(xlUp).Row + 1
        ThisWorkbook.Sheets("DeltaMan").Cells(srow, 1).PasteSpecial (xlPasteValues)

But here comes the biggest challenge.

Raw sheet details:

I want the data to be copied to their respective sheets , but the row's data needs to be shuffled in this way

Can this be done? So the macro should do this :
-If a row that 55711 in Col. A , then copy data from column C (date) and paste in Column A of 'DeltaMan' sheet, etc etc.


Can someone please help me here.

 

[galbatrox9]

I just thought I would throw this in. The revised macro would look something like this referencing column B of the Raw sheet for the sheet name:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim bottomA As Long
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim AccNum As Range
    For Each AccNum In Range("A2:A" & bottomA)
        Sheets(AccNum.Offset(0, 1).Value).Cells(Sheets(AccNum.Offset(0, 1).Value).Rows.Count, "A").End(xlUp).Offset(1, 0) = AccNum
        Sheets(AccNum.Offset(0, 1).Value).Cells(Sheets(AccNum.Offset(0, 1).Value).Rows.Count, "B").End(xlUp).Offset(1, 0) = AccNum.Offset(0, 1)
        Sheets(AccNum.Offset(0, 1).Value).Cells(Sheets(AccNum.Offset(0, 1).Value).Rows.Count, "C").End(xlUp).Offset(1, 0) = AccNum.Offset(0, 2)
        Sheets(AccNum.Offset(0, 1).Value).Cells(Sheets(AccNum.Offset(0, 1).Value).Rows.Count, "F").End(xlUp).Offset(1, 0) = AccNum.Offset(0, 3)
        Sheets(AccNum.Offset(0, 1).Value).Cells(Sheets(AccNum.Offset(0, 1).Value).Rows.Count, "K").End(xlUp).Offset(1, 0) = AccNum.Offset(0, 4)
        Sheets(AccNum.Offset(0, 1).Value).Cells(Sheets(AccNum.Offset(0, 1).Value).Rows.Count, "M").End(xlUp).Offset(1, 0) = AccNum.Offset(0, 5)
        Sheets(AccNum.Offset(0, 1).Value).Cells(Sheets(AccNum.Offset(0, 1).Value).Rows.Count, "O").End(xlUp).Offset(1, 0) = AccNum.Offset(0, 7)
    Next AccNum
    Application.ScreenUpdating = True
End Sub

If you run the macro twice, however, you will get duplicate values in the account sheets. If this is a problem, please let me know and I will revise the macro.

I have having an issue with the initial code buddy.

When i run the macro again, if last row of data's column M does not have any value in it, when i run it again the new row's column M data will go to the previous row.

Eg :

Last row is 4. And at (4,M) there is nothing in the cell.
If i run the macro again, i will get a row 5, but the value that was supposed to be at (5,M) will go to (4,M) since that cell was empty previously.

Can this be ignored in the formulas? I would want to have that every time the macro is run, the new rows of data gets added after the last cell of data of column A.

 

[galbatrox9]

I had to change the sheet names again, thats why i didnt want to use the account number reference for their names. They are now Aplha numeric, but random.

 

[Fluff]

Untested, but how about

Sub CopyData()
    Application.ScreenUpdating = False
    Dim bottomA As Long
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim AccNum As Range
    For Each AccNum In Range("A2:A" & bottomA)
        With Sheets(AccNum.Offset(0, 1).Value).Cells(Sheets(AccNum.Offset(0, 1).Value).Rows.Count, "A").End(xlUp).Offset(1)
            .Value = AccNum
            .Offset(, 1) = AccNum.Offset(0, 1)
            .Offset(, 2) = AccNum.Offset(0, 2)
            .Offset(, 5) = AccNum.Offset(0, 3)
            .Offset(, 10) = AccNum.Offset(0, 4)
            .Offset(, 12) = AccNum.Offset(0, 5)
            .Offset(, 14) = AccNum.Offset(0, 7)
         End With
    Next AccNum
    Application.ScreenUpdating = True
End Sub

 

[galbatrox9]

Untested, but how about

Sub CopyData()
    Application.ScreenUpdating = False
    Dim bottomA As Long
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim AccNum As Range
    For Each AccNum In Range("A2:A" & bottomA)
        With Sheets(AccNum.Offset(0, 1).Value).Cells(Sheets(AccNum.Offset(0, 1).Value).Rows.Count, "A").End(xlUp).Offset(1)
            .Value = AccNum
            .Offset(, 1) = AccNum.Offset(0, 1)
            .Offset(, 2) = AccNum.Offset(0, 2)
            .Offset(, 5) = AccNum.Offset(0, 3)
            .Offset(, 10) = AccNum.Offset(0, 4)
            .Offset(, 12) = AccNum.Offset(0, 5)
            .Offset(, 14) = AccNum.Offset(0, 7)
         End With
    Next AccNum
    Application.ScreenUpdating = True
End Sub

Hey, this one didnt work. I think this is based on the assumption that the sheet name is the name of the account? but thats not the case for me right now.

 

[Fluff]

Try modifying the code mumps supplied in post#11 like this

With Sheets("DeltaMan").Cells(Sheets("DeltaMan").Rows.Count, "A").End(xlUp).Offset(1, 0)
   .Value = AccNum
   .Offset(1, 1) = AccNum.Offset(0, 1)
   .Offset(1, 2) = AccNum.Offset(0, 2)
   .Offset(1, 6) = AccNum.Offset(0, 3)
   .Offset(1, 10) = AccNum.Offset(0, 4)
   .Offset(1, 12) = AccNum.Offset(0, 5)
   .Offset(1, 14) = AccNum.Offset(0, 7)
End With