PDA

View Full Version : [SOLVED] Modifications to macro that copies cells that contain the name of a worksheet



1819
09-18-2016, 05:50 AM
The following macro works well to copy cells in column A of Sheet1 that include the title of another worksheet.

Therefore, say cell A26 of Sheet1 is "Armadillos come from Texas", the macro will copy cell A26 to the next available cell in column A of the worksheet called "Texas".

However, I would like the following modifications:

1) If a cell in column A of Sheet1 contains a hyperlink, I need the hyperlink to be preserved. At the moment, it just pastes text and I lose the hyperlink.
2) I would like the whole row to be sent from Sheet1, not just column A. Though I still only need column A matched to the names of other worksheets.
3) I would like the whole row in Sheet1 to be deleted once it is copied to another worksheet.

The current code is:



Sub Move_snb()
sn = Application.Transpose(Sheets("Sheet1").Cells(1).CurrentRegion.Columns(1).Value)

For Each sh In Sheets
sp = Filter(sn, sh.Name)
If UBound(sp) > -1 Then sh.Cells(1).Resize(UBound(sp) + 1) = Application.Transpose(sp)
Next
End Sub


Many thanks.

mana
09-18-2016, 06:43 AM
Option Explicit

Sub test()
Dim rr As Range, r As Range
Dim n As Long
Dim mySheet As String
Dim ws As Worksheet

mySheet = "Sheet1"

Set rr = Worksheets(mySheet).Cells(1).CurrentRegion


For Each ws In Worksheets
n = 0
If ws.Name <> mySheet Then
For Each r In rr.Rows
If InStr(r.Cells(1).Value, ws.Name) > 0 Then
n = n + 1
r.Copy ws.Cells(n, 1)
r.ClearContents
End If
Next
End If
Next

End Sub

1819
09-18-2016, 07:27 AM
That's terrific. It will save me hours of work. Thank you!