Excel VBA to convert specific worksheets to vaslues not working

[Suvster]

Hi all,

I'm fairly new to VBA and have been trying to muddle together a VBA macro to basically select a predefined folder, open any workbooks within that folder (ideally, i wouldn't even open the workbooks if possible but thought this would be far to complex for me starting out) and copy and paste the contents of specified worksheets (identified in an array) as values.

Below is what i've managed from taking bits here and there online.

The requirement was to make certain tables static rather than dynamic as we are linking to them with another application and the dynamic text doesn't link through.

I've gone through quite a few variations of this code but this seemed to be the closest i got to one actually working and i feel like it just needs a more experienced mind to tweak it.

I'm sure there are many things i could do to improve this but my first priority was to just get it to work.

Any help is appreciated.

Sub version2()


    Dim MyPath          As String
    Dim MyFile          As String
    Dim Wkb             As Workbook
    Dim Cnt             As Long
    Dim Assets          As Variant
    Dim Asset           As Variant
    
Assets = Array("Geogr_segments", "Options_2", "PPE_short")
        
    Application.ScreenUpdating = False
    
    MyPath = ThisWorkbook.Path & "\Convert\" 'change the path accordingly
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    
    MyFile = Dir(MyPath & "*.xlsx")
    
    Cnt = 0
    Do While Len(MyFile) > 0
        Cnt = Cnt + 1
        Set Wkb = Workbooks.Open(MyPath & MyFile)
            For Each Asset In Assets
            'my code here
            Wkb.Worksheets(Asset).Select
            Range("F17").Activate
            Selection.Copy
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
               :=False, Transpose:=False
            Next Asset
        Wkb.Close savechanges:=True
        MyFile = Dir
    Loop
    
    If Cnt > 0 Then
        MsgBox "Completed...", vbExclamation
    Else
        MsgBox "No files were found!", vbExclamation
    End If
    
    Application.ScreenUpdating = True
    
End Sub

 

[JLGWhiz]

See if this works for you

Sub version3()
    Dim MyPath          As String
    Dim MyFile          As String
    Dim Wkb             As Workbook
    Dim Cnt             As Long
    Dim Assets          As Variant
    Dim Asset           As Long
Assets = Array("Geogr_segments", "Options_2", "PPE_short")
    Application.ScreenUpdating = False
    MyPath = ThisWorkbook.Path & "\Convert\" 'change the path accordingly
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    MyFile = Dir(MyPath & "*.xlsx")
    Cnt = 0
    Do While Len(MyFile) > 0
        Cnt = Cnt + 1
        Set Wkb = Workbooks.Open(MyPath & MyFile)
            For Asset = LBound(Assets) To UBound(Assets)
            'my code here
                With Wkb.Worksheets(Assets(Asset)).Range("F17")
                    .Value = .Value
                End With
            Next
            Wkb.Close savechanges:=True
        MyFile = Dir
    Loop
    If Cnt > 0 Then
        MsgBox "Completed...", vbExclamation
    Else
        MsgBox "No files were found!", vbExclamation
    End If
    Application.ScreenUpdating = True
End Sub

 

[Suvster]

Hi JLGWhiz,

Thank you for the speedy response. I tried out your version of the script but unfortunately it didn't paste the values without the formulas still.

I know i can manually select multiple worksheets, copy the values and paste the whole lot using Paste special values but when i've tried to incorporate that into this sript if fails.
Do you think i need to be a bit more methodical with the script in how it cycles through the defined assets or should it not be a problem to mimic the manual process of copying multiple worksheets and pasting?

Thanks again for your help.

Cheers

Rich