?
Solved

Copy/Paste Macro

Posted on 2011-03-18
6
Medium Priority
?
376 Views
Last Modified: 2012-05-11
Hello,

I need a macro that will:
 1. Copy the Star in M1
 2. Paste the Star in M1 in cell in the cells with "• "  in the cell Range M:DL

Please see the attached document.

Any Takers?
Test.xlsm
0
Comment
Question by:ctownsen80
6 Comments
 
LVL 24

Expert Comment

by:StephenJR
ID: 35168949
This perhaps?
Sub Macro1()

Dim r As Range

Application.ScreenUpdating = False

With Sheets("Test")
    .Shapes("AutoShape 6").Copy
    For Each r In .Range("M10:DL254")
        If r.Value <> "" Then
            r.PasteSpecial
            .Shapes(.Shapes.Count).Left = r.Left
            .Shapes(.Shapes.Count).Top = r.Top
        End If
    Next r
End With

Application.ScreenUpdating = True

End Sub

Open in new window

0
 
LVL 14

Expert Comment

by:JP
ID: 35169071
This code will do the same but if you change the file and need to go more than 254 rows this will accomidate it.
Sub Macro1()

Dim myRange As Range
Dim lastrec As Long
lastrec = [a65536].End(xlUp).Row
Application.ScreenUpdating = False
Set myRange = Range("M10", "DL" & lastrec)
For Each cell In myRange
    If cell.Value <> "" Then
    ActiveSheet.Shapes.Range(Array("AutoShape 6")).Select
    Selection.Copy
    cell.Select
    ActiveSheet.Paste
    End If
Next cell
End Sub

Open in new window

0
 
LVL 29

Expert Comment

by:leonstryker
ID: 35169093
I think using the Find method woudl be a lot faster:

Sub CopyStar()
Dim objStar As Shape
Dim lCount As Long, lngTotal As Long
    Application.ScreenUpdating = False
    Set objStar = ActiveSheet.Shapes("AutoShape 6")
    objStar.Copy
    lngTotal = WorksheetFunction.CountIf(Cells, " •")
    For lCount = 1 To lngTotal
        Cells.Find(What:=" •", After:=ActiveCell, SearchDirection:=xlNext).Activate
        ActiveSheet.Paste
        Application.StatusBar = "Pasting Star " & lCount & " of " & lngTotal
    Next
    Application.StatusBar = False
End Sub
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:ctownsen80
ID: 35182657
leonstryker,

Thanks a bunch!  Your method works almost perfectly.  However the copystar code stops in the actual file in row 395.  I actually have 1100 row that may need to be updated.  Please advise.
0
 
LVL 29

Accepted Solution

by:
leonstryker earned 2000 total points
ID: 35193190
However the copystar code stops in the actual file in row 395.

Not sure what you mean by that. Do you mean it does not replace all of the items? If so, try this:

Sub CopyStar()
Dim objStar As Shape
Dim lCount As Long, lngTotal As Long
    Application.ScreenUpdating = False
    Range("A1").Select
    Set objStar = ActiveSheet.Shapes("AutoShape 6")
    objStar.Copy
    lngTotal = WorksheetFunction.CountIf(Cells, " •")
    For lCount = 1 To lngTotal
        Cells.Find(What:=" •", After:=ActiveCell, SearchDirection:=xlNext).Activate
        ActiveSheet.Paste
        Application.StatusBar = "Pasting Star " & lCount & " of " & lngTotal
    Next
    Range("A1").Select
    Application.StatusBar = False
End Sub
0
 

Author Closing Comment

by:ctownsen80
ID: 35194533
This guy is great!
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

621 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question