Results 1 to 8 of 8

Trying to Change this code to make it paste 'Values' only.

Threaded View

  1. #1
    Registered User
    Join Date
    01-23-2013
    Location
    Baltimore
    MS-Off Ver
    Excel 2010
    Posts
    4

    Trying to Change this code to make it paste 'Values' only.

    HI All - Very new to this forum and also vba. I don't know much, so I appreciate any help.

    I currently have this code. It copies and pastes data from a specific range that I've specified of multiple workbooks of a specific tab, into a master sheet. The data from each workbook is pasted directly under the information that it collected from the last workbook that was opened.

    It is currently pasting the formulas; however, I need it to paste values only. Can anyone edit this code to fix that? Other than this, it works perfectly.

    Thanks!

    Ron






    Sub TestCopyDataFromMultipleWorkbooks()
    ' updated 2008-04-30 by OPE
    Dim varWorkbooks As Variant, wb As Workbook
        varWorkbooks = "Excel Workbooks (*.xl*),*.xl*,All Files (*.*),*.*"
        varWorkbooks = Application.GetOpenFilename(varWorkbooks, 1, _
            "Select one or more workbooks to copy data from (Ctrl+A selects all items in the folder)", , True)
        If Not IsArray(varWorkbooks) Then Exit Sub ' the user cancelled the dialog
        
        With Application
            .ScreenUpdating = False
            .Cursor = xlWait
        End With
        
        Set wb = Workbooks.Add ' create the new report workbook
        
        ' the following line(s) must be customized for each copy task
        ' copy from one named worksheet:
        CopyDataFromMultipleWorkbooks wb.Worksheets(1), varWorkbooks, "Load Summary ", "A9:P26"
        ' copy from the first (or another numbered) worksheet:
        'CopyDataFromMultipleWorkbooks wb.Worksheets(1), varWorkbooks, 1, "A9:P26"
        ' copy from all worksheets:
        'CopyDataFromMultipleWorkbooks wb.Worksheets(1), varWorkbooks, vbNullString, "A9:P26"
        
        wb.Activate
        Set wb = Nothing
        
        With Application
            .Cursor = xlDefault
            .StatusBar = False
            .ScreenUpdating = True
        End With
    End Sub
    
    Sub CopyDataFromMultipleWorkbooks(wsTarget As Worksheet, varWorkbooks As Variant, _
        varWorksheet As Variant, strWorksheetRange As String)
    ' updated 2008-04-30 by OPE
    Dim r As Long, i As Long, wb As Workbook, ws As Worksheet, rng As Range
        If wsTarget Is Nothing Then Exit Sub ' no target workbook
        ' assumes that wsTarget is a new unfiltered worksheet
        If Not IsArray(varWorkbooks) Then Exit Sub ' invalid input
        
        For i = LBound(varWorkbooks) To UBound(varWorkbooks)
            On Error Resume Next
            Set wb = Workbooks.Add(varWorkbooks(i)) ' try to open a copy of the workbook
            On Error GoTo 0
            If Not wb Is Nothing Then
                With wb
                    Application.StatusBar = "Copying information from " & varWorkbooks(i) & "..."
                    If Len(varWorksheet) = 0 Then ' no worksheet name specified, copy from all worksheets
                        For Each ws In .Worksheets
                            With wsTarget ' find the next target row to paste the copied content
                                ' the following line assumes that column A always is populated
                                r = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                            End With
                            On Error Resume Next
                            Set rng = ws.Range(strWorksheetRange)
                            If Not rng Is Nothing Then ' the range exists
                                rng.Copy wsTarget.Range("A" & r) ' copy the source range to the target worksheet
                                Set rng = Nothing
                            End If
                            On Error GoTo 0
                        Next ws
                        Set ws = Nothing
                    Else ' copy from one worksheet
                        On Error Resume Next
                        Set ws = wb.Worksheets(varWorksheet)
                        On Error GoTo 0
                        If Not ws Is Nothing Then ' the worksheet exists
                            With wsTarget ' find the next target row to paste the copied content
                                ' the following line assumes that column A always is populated
                                r = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                            End With
                            On Error Resume Next
                            Set rng = ws.Range(strWorksheetRange)
                            If Not rng Is Nothing Then ' the range exists
                                rng.Copy wsTarget.Range("A" & r) ' copy the source range to the target worksheet
                                Set rng = Nothing
                            End If
                            On Error GoTo 0
                            Set ws = Nothing
                        End If
                    End If
                    .Close False ' close the workbook copy without saving any changes
                    Application.StatusBar = False
                End With
                Set wb = Nothing
            End If
        Next i ' next workbook
    End Sub
    Last edited by RWarczy; 01-23-2013 at 02:00 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1