Copy data and paste in concerned sheet in list

[abdulncr]

Dear Friends,

I have below code to copy the data and paste in concerned sheet, sheet name is mentioned Sheet98.Range("C12:C137"). this is perfectly working, currently it is pasting in the second row of concerned sheet, I wanted paste data 25th row of concerned sheet, I am trying to change the below part of the code, not succeeded, could you please help me on this.

r1.Copy sh1.Cells(sh1.Rows.Count, "D").End(xlUp).Offset(1, 0)

Sub copytosheet()

Dim lstrw As Integer
 

Dim sh As Worksheet, sh1 As Worksheet
Dim r As Range, cell As Range, r1 As Range


 
Set sh = Sheet98

Set r = Sheet98.Range("C12:C137")

For Each cell In r


 If Len(Trim(cell.Value)) > 0 Then
  Set sh1 = Nothing
  On Error Resume Next
  Set sh1 = Worksheets(cell.Text)
  On Error GoTo 0
  If Not sh1 Is Nothing Then
  
  Set r1 = sh.Range(sh.Cells(cell.Row, "E"), sh.Cells(cell.Row, "G"))
  r1.Copy sh1.Cells(sh1.Rows.Count, "D").End(xlUp).Offset(1, 0)
  
  End If
 End If
Next

End Sub

 

[Derek McGill]

If you change offset(1,0) to (25,0) does it work ?

 

[abdulncr]

Dear Derek,

Thank you for your reply.
in your solution if there are five lines to copy to concerned sheet, it make the gap of 25 rows between each line.

Thanks
Abd

 

[jindon]

I wanted paste data 25th row of concerned sheet

  r1.Copy sh1.Cells(25, "D")

?

 

[Derek McGill]

Can you post workbook so people can see what you are trying to do ?

 

[abdulncr]

  r1.Copy sh1.Cells(25, "D")

?

Dear Jindon,

thanks for your reply.

in your solution if there are five lines to copy to concerned sheet, it copy all five line in 25th row replacing the first value, so only last value remain cell

 

[abdulncr]

Friends,
I have attached sample file with code, where the sheet name is mentioned in C, I wanted copy value1, value2, and value3 and paste in concerned sheet in 25th row. I tried with lot of change. not succeeded this case.
Appreciate your help

 

[jindon]

Is this what you are trying to do?

Sub test()
    Dim r As Range, e, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Sheets("master").Range("a2").CurrentRegion
        For Each r In .Columns("C").Cells
            If r.Value <> "" Then
                If Not dic.exists(r.Value) Then
                    Set dic(r.Value) = r(, 3).Resize(, 3)
                Else
                    Set dic(r.Value) = Union(dic(r.Value), r(, 3).Resize(, 3))
                End If
            End If
        Next
    End With
    For Each e In dic
        If Evaluate("isref('" & e & "'!a1)") Then dic(e).Copy Sheets(e).Range("d25")
    Next
End Sub

 

[abdulncr]

Dear Jindon,

Really great, working elegant.

I know little code, but it is bouncing to my head, create object is new to me.
is it possible to help to learn this

 If Evaluate("isref('" & e & "'!a1)") Then dic(e).Copy Sheets

Thanks
abd

 

[jindon]

Ok, I will reply to you tomorrow.
It is already past midnight here.

 

[jindon]

CreateObject, Dictionary, Evaluate is in Excel vb help.

IsRef worksheetfunction will be found in Excel help.

Read the details first and if you still do not understand, post back.