Using the value of a cell as the location for placing data into another worksheet

[ksroskel]

I have two columns of data. The first column contains text fields. Th
second column speicifes the cell location that I would like to copy th
text field, in the first colum, into. For Example on sheet1 I have:

A B C
1 test1 A1
2 test2 A10
3 test3 B15

I would like to copy test1 to location A1 on sheet 2, and copy test2 t
A10 on sheet2, etc.

Keit

 

[Dave Peterson]

How about something like:

Option Explicit
Sub testme01()

Dim fWks As Worksheet
Dim tWks As Worksheet
Dim testRng As Range

Dim myCell As Range

Set fWks = Worksheets("sheet1")
Set tWks = Worksheets("sheet2")

With fWks
For Each myCell In .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
Set testRng = Nothing
On Error Resume Next
Set testRng = tWks.Range(myCell.Offset(0, 1).Value)
On Error GoTo 0
If testRng Is Nothing Then
MsgBox "error with row " & myCell.Row
Else
testRng.Value = myCell.Value
End If
Next myCell
End With

End Sub

 

[ksroskel]

Dave,

That works great ... Thanx

BTW, is there a way to swap the columns and rows when I copy t
sheet2?

Keit

 

[Dave Peterson]

So C5 would be mapped to row 3, column 5 (E3)?

I think I'd adjust the data entry in column B. The macro can do it, but looking
at the input and then examining the output would make my brain hurt!

But this worked ok for me:

Option Explicit
Sub testme01()

Dim fWks As Worksheet
Dim tWks As Worksheet
Dim testRng1 As Range
Dim testRng2 As Range

Dim myCell As Range

Set fWks = Worksheets("sheet1")
Set tWks = Worksheets("sheet2")

With fWks
For Each myCell In .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
Set testRng1 = Nothing
On Error Resume Next
Set testRng1 = tWks.Range(myCell.Offset(0, 1).Value)
On Error GoTo 0
If testRng1 Is Nothing Then
MsgBox "error with row " & myCell.Row
Else
Set testRng2 = Nothing
On Error Resume Next
Set testRng2 = tWks.Cells(testRng1.Column, testRng1.Row)
On Error GoTo 0
If testRng2 Is Nothing Then
MsgBox "error with transposing address in row " _
& myCell.Row
Else
testRng2.Value = myCell.Value
End If
End If
Next myCell
End With

End Sub