MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Confused!


Posted by wiggy on May 16, 2001 12:39 PM

Does anyone out there know how to copy text from one worksheet to another based upon the value of a cell next to it?
i.e. if cell, “A2” contains the text “cat” and cell “A3” has a value of 2, then the macro copies "cat" and pastes it in worksheet 2
if “A3” has a value of 3, then the text is pasted into worksheet 3

Thanks
Wiggy


Posted by Barrie Davidson on May 16, 2001 2:26 PM

Wiggy, the following macro assumes that you want to copy the activecell to the sheet name specified in the cell below it in cell A1 of the specified sheet.

Sub Copy_Macro()
Dim Copy_to_Sheet As String

Copy_to_Sheet = ActiveCell.Offset(1, 0).Value
ActiveCell.Copy
Sheets(Copy_to_Sheet).Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False

End Sub

If this doesn't work for you let me know.

Barrie

Posted by Dave Hawley on May 17, 2001 12:55 AM


Hi Wiggy

Try this

Sub SelectiveCopy()
Dim i As Integer

With Sheets("Sheet1")

If .Range("A2") = "Cat" Then
If IsNumeric(.Range("A3").Value) Then
If .Range("A3").Value > 0 Then
i = .Range("A3").Value
Worksheets(i).Range("A2") = .Range("A2")
End If
End If
End If

End With

End Sub

Dave


OzGrid Business Applications

Posted by Wiggy on May 17, 2001 12:58 PM

End With End Sub

Thanks for looking in Dave,

Been banging my head againgst a brick wall with this one, tried autofilters, cutting pasting and all sorts of in-elegant solutions, never knew just a few lines of code could sort out this problem.
If its not too much trouble, could I ask how you would get the code to repeat for the remainder of the spreadsheet, think I know how to force the data down on the pasted worksheet to avoid overwriting.

Thanks once again.
Wiggy

Posted by Wiggy on May 17, 2001 1:22 PM

Wiggy, the following macro assumes that you want to copy the activecell to the sheet name specified in the cell below it in cell A1 of the specified sheet. Sub Copy_Macro()

Barrie,

Thanks for getting back to me, but this is not really what I'm looking for, I do however appreciate your efforts in trying to assist.
It seems that there are only a few of you "good guys" out there trying to hel us mere mortals!

As you browse through the many questions people come up with, only a few people are good enough to reply!

Thanks once again;
Wiggy

Posted by Dave Hawley on May 17, 2001 11:22 PM

: End With : End Sub

Sure wiggy, try this


Sub SelectiveCopy()
Dim i As Integer
Dim rLookRange As Range
Dim rCell As Range

With Sheets("Sheet1")
Set rLookRange = .Range("A2", .Range("A65536").End(xlUp))

For Each rCell In rLookRange
If rCell = "Cat" Then
If IsNumeric(rCell.Offset(1, 0).Value) Then
If rCell.Offset(1, 0).Value > 0 Then
i = rCell.Offset(1, 0).Value
Worksheets(i).Range("A2").End(xlDown).Offset(1, 0) _
= rCell.Offset(1, 0).Value
End If
End If
End If
Next rCell
End With

Set rLookRange = Nothing
End Sub

Dave

OzGrid Business Applications

Posted by Dave Hawley on May 17, 2001 11:24 PM

: End With : End Sub

Sure wiggy, try this


Sub SelectiveCopy()
Dim i As Integer
Dim rLookRange As Range
Dim rCell As Range

With Sheets("Sheet1")
Set rLookRange = .Range("A2", .Range("A65536").End(xlUp))

For Each rCell In rLookRange
If rCell = "Cat" Then
If IsNumeric(rCell.Offset(1, 0).Value) Then
If rCell.Offset(1, 0).Value > 0 Then
i = rCell.Offset(1, 0).Value
Worksheets(i).Range("A2").End(xlDown).Offset(1, 0) _
= rCell.Offset(1, 0).Value
End If
End If
End If
Next rCell
End With

Set rLookRange = Nothing
End Sub

Dave

OzGrid Business Applications