Copy Data Row By Row

[Gatewaya89]

Hi All

I have a spreadsheet which has 32 branch locations in the consolidation sheet and this works fine and consolidates all the data from 2 other sheets, My problem is that I now need a macro which can copy out row by row to each of the branch destination sheets but not remove the data from the consolidation sheet (if that makes any sense?)

So lets say the first branch is called Barking then what I need the macro to do is look at the consolidation sheet identify the coloumn & row with Barking branch in it(Branch Name is always in coloumn "B" and then copy data from Col "C" to Col "I" in what ever row Barking sits?and then continue doing this until all location data has been copied to relevant branch sheet!

All these sheets are in a Workbook called "Data Entry"

Is this possible I ask?

Await anyones help on this

[bakerman2]

Create a unique list of all branches and loop through that list to set autofilter criteria. Then copy filtered rows to branch sheet and move on to next item in unique branch list.

[Gatewaya89]

Hi

Not sure how that would be done?I have upload a copy of the sheet perhaps you can figure out why the macro on the data sheet will not copy into the relevant sheets named branches?

Hope you can sort it?

[Kamboj]

First create all sheets with branch name. Here I created 3 sheets - a,b & c.

[Gatewaya89]

Hi

Thanks for that but when I look at the macro couldn't get my head round what it was doing?

[bakerman2]

Sub TransferWeeklyData()


Rem If MsgBox("Do You Want To Now Clear The Current Data Entered To Its Relevant Destination Sheets?If You Choose Yes then this will Clear And Transfer Your Data If You Choose No Then This Will Return To The Data Entry Sheet With No Action Taken?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Rem If MsgBox("Have You Checked That You Have Entered Correct Week Number?", vbQuestion + vbYesNo) = vbNo Then Exit Sub

Dim ws As Worksheet, wsDATA As Worksheet
Dim LR As Long, Rw As Long, wkRw As Long, Wk As Long

Set wsDATA = Sheets("Data Entry")
Wk = wsDATA.Range("L2").Value
LR = wsDATA.Range("A" & Rows.Count).End(xlUp).Row

For Rw = 2 To LR
    If WorksheetFunction.CountA(wsDATA.Range("C" & Rw).Resize(, 7)) > 0 Then
        With Sheets(wsDATA.Range("B" & Rw).Value & " " & wsDATA.Range("A" & Rw))
            .Cells(Application.Match(Wk, .Columns(1), 0), 2).Resize(, 7).Value = wsDATA.Range("C" & Rw).Resize(, 7).Value
        End With
    End If
Next Rw

End Sub

[Gatewaya89]

Thank you bakerman2 works well will just add clearcontents to end of macro now and that should clear the data entry sheet?

thks once again

[Gatewaya89]

Hi

Sorry to bother you again but its stopped working on the following line?

.Cells(Application.Match(Wk, .Columns(1), 0), 2).Resize(, 7).Value = wsDATA.Range("C" & Rw).Resize(, 7).Value

Have no idea why as all I have done is entered data in the data entry sheet ready to send to all the other sheets?

Any ideas?

[bakerman2]

wsDATA.Range("C2:I" & LR).ClearContents

Thanks for the rep.

[bakerman2]

No Weeknumber in L2 ? Invalid weeknumber ? Weeknumber missing in one of the sheets ?
In your example file it works perfectly.

[Gatewaya89]

Hi

Yep! what an idiot I am..lol I forgot to place a week number in there so it stopped working..lol

Thank you again for all the help and really sorry to bother you will look next time before asking..lol

[Gatewaya89]

sorted it was a wrong name?