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

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)
End Sub

Many thanks.

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)
End If
End If

End Sub

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