Consulting

Results 1 to 4 of 4

Thread: Cycle thru worksheets and import shape according to dynamic values

  1. #1
    VBAX Regular
    Joined
    Mar 2008
    Posts
    24
    Location

    Cycle thru worksheets and import shape according to dynamic values

    I have a workbook with blue-tabbed wkshts and red-tabbed wkshts.
    I would like to cycle through the red-tabbed worksheets, and if the value of Range AH is the same as the name of one of the blue-tabbed worksheets, import the shape named "linedrawing" from that worksheet.
    Repeat until done.
    All the blue-tabbed worksheets have the exact same formatting, the shape is actually a picture, and it has the same position and same name in all the different blue-tabbed sheets.

    What I have so far (which absolutely is off in another galaxy) is:

    [vba]
    Sub CopyDrawings()

    Dim shp As Shape
    Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Sheets

    'If ws.Tab.ColorIndex = 3 Then

    ws.Activate

    For Each c In ActiveSheet.Range("$AH$50:$AH$2000")
    If c.Value = ws.Name Then
    ws.shp("linedrawing").Select
    Selection.Copy
    c.Offset(rowOffset:=0, columnOffset:=-31).Select
    ActiveSheet.Paste
    MsgBox "OK?"
    End If
    Next
    End If
    Next

    End Sub
    [/vba]
    I know i am not selecting things properly.

    I had posted it on another site, got no help, closed it down.

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,198
    Location
    I would imagine a sample workbook would give you a better chance finding a solution to this problem.
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2403, Build 17425.20146

  3. #3
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    Sub CopyDrawings()
    Const MATCH_FORMULA As String = _
    "MATCH(TRUE,ISNUMBER(MATCH('<ws>'!H5:H20,{""<names>""},0)),0)"
    Dim VecBlue As Variant
    Dim shp As Shape
    Dim ws As Worksheet
    Dim RowNum As Long
    Dim SheetNames As String
    Dim i As Long

    ReDim VecBlue(1 To ActiveWorkbook.Worksheets.Count)
    For Each ws In ActiveWorkbook.Worksheets

    If ws.Tab.ColorIndex = 5 Then

    i = i + 1
    VecBlue(i) = ws.Name
    End If
    Next ws
    ReDim Preserve VecBlue(1 To i)

    SheetNames = Join(VecBlue, ",")
    SheetNames = Replace(SheetNames, ",", """,""")

    For Each ws In ActiveWorkbook.Worksheets

    If ws.Tab.ColorIndex = 3 Then

    On Error Resume Next
    RowNum = ws.Evaluate(Replace(Replace(MATCH_FORMULA, "<names>", SheetNames), "<ws>", ws.Name))
    On Error GoTo 0
    If RowNum > 0 Then

    Worksheets(ws.Range("H5:H20").Cells(RowNum).Value).Shapes("linedrawing").Co py
    ws.Activate
    Cells(ws.Range("H5:H20").Cells(RowNum).Row, "C").Select
    ActiveSheet.Paste
    End If
    End If
    Next ws
    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  4. #4
    VBAX Regular
    Joined
    Mar 2008
    Posts
    24
    Location
    Works extremely well, except I forgot to mention I need to cycle through the Range - right now it only imports the first value it finds in the Range AH5:AH20 I need to import the shapes if c.value<>""

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •