Copy Paste from one sheet to another sheet with different constraints

[Nidhi210]

I have two sheet.One contains Pivot table which has category name with different zone(North,East,West,South,CSD) and values in these zones category specific month wise.I need to copy this sheet with specific category to another sheet which has different sheets of category.Now I want code which can copy category from the Pivot sheet and paste value in sheet which has different sheet named based on category.Also it should be zone specific as not every time the category contains each and every zone value,month wise.the category name should be identified based on the name in the destination sheet ,Any help will be highly appreciated.

 

[jindon]

Should work on your workbook provided.

Sub test()
    Dim r As Range, ws As String, c As Range
    Dim x As Range, i As Long, t As Long
    With Sheets("pivot").[c3].CurrentRegion
        With .Offset(1).Resize(.Rows.Count - 1)
            For Each r In .Columns(1).SpecialCells(4).Areas
                ws = r(0).Value
                For Each c In r(0, 2).Resize(r.Count + 1)
                    Set x = Sheets(ws).Cells.Find(c)
                    If Not x Is Nothing Then
                        t = 2
                        For i = 3 To .Columns.Count Step 3
                            x(, t).Resize(, 3).Value = _
                            c(, i - 1).Resize(, 3).Value: t = t + 4
                        Next
                    End If
                Next
            Next
        End With
    End With
End Sub

 

[Nidhi210]

Showing error in this command:
Set x = Sheets(ws).Cells.Find(c).No able to identify the the name of the workbook when I am specifying the name of the workbook

 

[jindon]

One possibility I can think of is you have Numeric sheet name.
Try change

ws = r(0).Value

to

ws = CStr(r(0).Value)

othereise, I need to see your workbook.

 

[mohadin]

Should work on your workbook provided.

Sub test()
    Dim r As Range, ws As String, c As Range
    Dim x As Range, i As Long, t As Long
    With Sheets("pivot").[c3].CurrentRegion
        With .Offset(1).Resize(.Rows.Count - 1)
            For Each r In .Columns(1).SpecialCells(4).Areas
                ws = r(0).Value
                For Each c In r(0, 2).Resize(r.Count + 1)
                    Set x = Sheets(ws).Cells.Find(c)
                    If Not x Is Nothing Then
                        t = 2
                        For i = 3 To .Columns.Count Step 3
                            x(, t).Resize(, 3).Value = _
                            c(, i - 1).Resize(, 3).Value: t = t + 4
                        Next
                    End If
                Next
            Next
        End With
    End With
End Sub

Hi;
I did tested it with excel 2013.
iT WORKS FINE

 

[Nidhi210]

Hi I have Uploaded my working replica sheet with many more sheets in DRM Draft FInal excel.Can u suggest the amendment to be done in the vba code

 

[jindon]

Can u suggest the amendment to be done in the vba code

What a waste of time...
You are asking completely different question now.

If you want the solution, you must upload a file with the "DATA", not a blank sheets.

 

[Nidhi210]

So the sheets I have attached as final consolidated file has the data in this, which needs to transferred to DRM Draft final in the format in the file.

 

[jindon]

How and where exactly to?

I don't think I can help you more, so please wait for someone else to comes in to help you.

 

[Nidhi210]

Thank u so much for the previous help..