Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
MACRO to Copy incl. hyperlinks
Hello,
I have found a nice macro wich copies contents (related to a value) into different sheets wich saves alot of time. Works fine exept i have Hyperlinks in column B and the names are copied but the hyperlinks are gone. Don't know how to correct it so that it runs the macro and copies column b so it maintains the hyperlink as org. column B. With other words i think i need a line wich says: Keep html formatting??? Option Explicit Sub ExtractReps() Dim ws1 As Worksheet Dim wsNew As Worksheet Dim Rng As Range Dim r As Integer Dim c As Range Set ws1 = Sheets("Sheet1") Set Rng = Range("loader") 'extract a list of Sales Reps ws1.Columns("c:c").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Range("L1"), Unique:=True r = Cells(Rows.Count, "c").End(xlUp).Row 'set up Criteria Area Range("Z1").Value = Range("c1").Value For Each c In Range("L2:L" & r) 'add the rep name to the criteria area ws1.Range("Z2").Value = c.Value 'add new sheet and run advanced filter Set wsNew = Sheets.Add wsNew.Move After:=Worksheets(Worksheets.Count) wsNew.Name = c.Value Rng.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet1").Range("Z1:Z2"), _ CopyToRange:=wsNew.Range("A1"), _ Unique:=False 'FIT WIDTH Rows("1:1").EntireRow.AutoFit Columns("A:A").ColumnWidth = 30.57 Columns("B:B").ColumnWidth = 30.57 Columns("C:C").ColumnWidth = 29.43 Columns("D:D").ColumnWidth = 33.14 Columns("E:E").ColumnWidth = 30 Columns("F:F").ColumnWidth = 19.57 Application.ScreenUpdating = False Dim numRows As Integer Dim r2 As Long Dim Rng2 As Range Dim lastrw As Long numRows = 1 lastrw = Cells(Rows.Count, "A").End(xlUp).Row Set Rng2 = Range(Cells(2, "A"), Cells(lastrw, "A")) For r2 = Rng.Rows.Count To 1 Step -1 Rng2.Rows(r2 + 1).Resize(numRows).EntireRow.Insert Next r2 Application.ScreenUpdating = True Next ws1.Select ws1.Columns("L:Z").Delete End Sub If someone could help, thanks a lot! (could be that some rubbish is in the code, but it works for me :) |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
MACRO to Copy incl. hyperlinks
If you copy a cell containing a "clickable" hyperlink and paste it elsewhere,
the pasted cell should also contain a "clickable" hyper link: Sub try_copy() Set r1 = Range("A1") Set r2 = Range("A2") r1.Copy r2 End Sub -- Gary''s Student - gsnu200715 " wrote: Hello, I have found a nice macro wich copies contents (related to a value) into different sheets wich saves alot of time. Works fine exept i have Hyperlinks in column B and the names are copied but the hyperlinks are gone. Don't know how to correct it so that it runs the macro and copies column b so it maintains the hyperlink as org. column B. With other words i think i need a line wich says: Keep html formatting??? Option Explicit Sub ExtractReps() Dim ws1 As Worksheet Dim wsNew As Worksheet Dim Rng As Range Dim r As Integer Dim c As Range Set ws1 = Sheets("Sheet1") Set Rng = Range("loader") 'extract a list of Sales Reps ws1.Columns("c:c").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Range("L1"), Unique:=True r = Cells(Rows.Count, "c").End(xlUp).Row 'set up Criteria Area Range("Z1").Value = Range("c1").Value For Each c In Range("L2:L" & r) 'add the rep name to the criteria area ws1.Range("Z2").Value = c.Value 'add new sheet and run advanced filter Set wsNew = Sheets.Add wsNew.Move After:=Worksheets(Worksheets.Count) wsNew.Name = c.Value Rng.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet1").Range("Z1:Z2"), _ CopyToRange:=wsNew.Range("A1"), _ Unique:=False 'FIT WIDTH Rows("1:1").EntireRow.AutoFit Columns("A:A").ColumnWidth = 30.57 Columns("B:B").ColumnWidth = 30.57 Columns("C:C").ColumnWidth = 29.43 Columns("D:D").ColumnWidth = 33.14 Columns("E:E").ColumnWidth = 30 Columns("F:F").ColumnWidth = 19.57 Application.ScreenUpdating = False Dim numRows As Integer Dim r2 As Long Dim Rng2 As Range Dim lastrw As Long numRows = 1 lastrw = Cells(Rows.Count, "A").End(xlUp).Row Set Rng2 = Range(Cells(2, "A"), Cells(lastrw, "A")) For r2 = Rng.Rows.Count To 1 Step -1 Rng2.Rows(r2 + 1).Resize(numRows).EntireRow.Insert Next r2 Application.ScreenUpdating = True Next ws1.Select ws1.Columns("L:Z").Delete End Sub If someone could help, thanks a lot! (could be that some rubbish is in the code, but it works for me :) |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
MACRO to Copy incl. hyperlinks
Thanks, you are all awesome! It works like a charm!
Best Regards J.Lemmens |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Hyperlinks: Hyperlinks change on copy/paste? | Excel Worksheet Functions | |||
Copy HYPERLINKS | New Users to Excel | |||
Macro project incl dcount, vlookup, etc?? help required | Excel Discussion (Misc queries) | |||
Sum on 2 criteria, incl #REF! | Excel Discussion (Misc queries) | |||
Filter copy incl more than it should | Excel Programming |