Copy paste from one worksheet to other.

[sa02000]

I have two worksheets -- Lets say ws1, ws2.

Data in ws1 looks like

column1
data1
data2
data3

Data in ws2 looks like

column1 column2
data1 value1
data1 value2
data1 value3
data2 value4
data2 value5
data3 value6
data3 value7
data3 value8
data3 value9

So now I would like to copy all the values in column2 of ws2
corresponding to each unique data row and paste in ws1 and I would like
to take transpose while pasting these in ws1. So, the finished data
looks like
this below....

Final data in ws1 looks like..
column1 column2 column3 column 4 column 5
data1 value1 value2 value3
data2 value4 value5
data3 value6 value7 value8 value9

I can do this manually by sorting ws2 by first column and copying the
rows for same data in column1 and then do paste special and transpose
data....but I have to do this for a list that is thousands of rows
long.
So the logic flow will look something like this.....
1. find and select rows with same value in column1 of ws2
2. Copy data in column2 of those selected rows
3. Find the row with the same data in column1 of ws1 as in column1 of
selection in ws2
4. Paste the copied cells (and take transpose at the same time) in ws1
starting at some specified column.

Any help is very appriciated.

Jay

 

[Tom Ogilvy]

Sub copydata()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, rng1 As Range
Dim rng2 As Range, ii As Long, i As Long
Dim res As Variant

Set ws2 = Worksheets("Data2")
Set ws1 = Worksheets("Data1")
lastrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = ws1.Range(ws1.Cells(1, 1), _
ws1.Cells(Rows.Count, 1).End(xlUp))
ii = lastrow
For i = lastrow To 2 Step -1
If ws2.Cells(i, 1) <> ws2.Cells(i - 1, 1) Or i = 2 Then
If i = 2 Then i = 1
Set rng2 = ws2.Cells(i, 2).Resize(ii - i + 1, 1)
res = Application.Match(Cells(i, 1), rng1, 0)
If Not IsError(res) Then
rng2.Copy
rng1(res).Offset(0, 1).PasteSpecial xlValue, Transpose:=True
End If
ii = i - 1
End If
Next

End Sub

Adjust sheet names to match.
Test on a copy of your data.

 

[sa02000]

Here is the code that I am trying. Its copying and pasting from one
worksheet to other but numbers are going into wrong place and its not
copy pasting that for all rows. So, during the debug, I found out that
res = error 2024 at certain value and thats where problem starts. I
checked my list and it has all numbers. Both lists are trimmed (trim
function). I compared both lists agains each other by doing two vlookup
and it return values ok. Anything else I can try or I might be missing
to diagnose the problem?

Sub copydata()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, rng1 As Range
Dim rng2 As Range, ii As Long, i As Long
Dim res As Variant

Set ws2 = Worksheets("All_PN")
Set ws1 = Worksheets("Family")
lastrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = ws1.Range(ws1.Cells(2, 1), ws1.Cells(Rows.Count,
1).End(xlUp))
ii = lastrow
For i = lastrow To 2 Step -1
If ws2.Cells(i, 1) <> ws2.Cells(i - 1, 1) Or i = 2 Then
If i = 2 Then i = 1
Set rng2 = ws2.Cells(i, 2).Resize(ii - i + 1, 1)
res = Application.Match(Cells(i, 1), rng1, 0)
If Not IsError(res) Then
rng2.Copy
rng1(res).Offset(0, 150).PasteSpecial xlValue,
Transpose:=True
End If
ii = i - 1
End If
Next

End Sub