Help with VBA Code

[Jbgs14]

Hi All -

See VBA code below which basically merges multiple tabs into a summary tab.

My issue here is that rather than just extracting the values it also extracts the formula - is there a way to amend the code below to just extra values from TABA, TABB and TABC and add them to the "SUMMARY" TAB?

Any help much appreciated.

Sub Extract()
Dim wsName_1 As String
Dim wsName_2 As String
Dim wsName_3 As String
Dim wsName_Result As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim Start_Row As Long
Dim Last_Row As Long
Dim Last_Col As Long
Dim rWS As Worksheet
Dim rStartRow As Long
Dim rLastRow As Long
Dim rLastCol As Long
'~~~~~~~~~~~~~~~~~~~~~~
wsName_1 = "TABA"
wsName_2 = "TABB"
wsName_3 = "TABC"
wsName_Result = "SUMMARY"
'~~~~~~~~~~~~~~~~~~~~~~
Set ws1 = ThisWorkbook.Sheets(wsName_1)
Set ws2 = ThisWorkbook.Sheets(wsName_2)
Set ws3 = ThisWorkbook.Sheets(wsName_3)
Set rWS = ThisWorkbook.Sheets(wsName_Result)

rStartRow = 8
rLastCol = rWS.Cells(rStartRow - 1, Columns.Count).End(xlToLeft).Column
rWS.Range(rWS.Cells(rStartRow, 1), rWS.Cells(Rows.Count, rLastCol)).ClearContents

Start_Row = 8
Last_Row = ws1.Range("A" & Rows.Count).End(xlUp).Row
If Last_Row >= Start_Row Then
    rLastRow = rWS.Range("A" & Rows.Count).End(xlUp).Row + 1
    If rLastRow < rStartRow Then
        rLastRow = rStartRow
    End If
    
    Last_Col = ws1.Cells(Start_Row - 1, Columns.Count).End(xlToLeft).Column
    ws1.Range(ws1.Cells(Start_Row, 1), ws1.Cells(Last_Row, Last_Col)).Copy
    rWS.Range("A" & rLastRow).PasteSpecial xlPasteAll
    Application.CutCopyMode = False
End If

Start_Row = 8
Last_Row = ws2.Range("A" & Rows.Count).End(xlUp).Row
If Last_Row >= Start_Row Then
    rLastRow = rWS.Range("A" & Rows.Count).End(xlUp).Row + 1
    If rLastRow < rStartRow Then
        rLastRow = rStartRow
    End If
    
    Last_Col = ws2.Cells(Start_Row - 1, Columns.Count).End(xlToLeft).Column
    ws2.Range(ws2.Cells(Start_Row, 1), ws2.Cells(Last_Row, Last_Col)).Copy
    rWS.Range("A" & rLastRow).PasteSpecial xlPasteAll
    Application.CutCopyMode = False
End If

Start_Row = 8
Last_Row = ws3.Range("A" & Rows.Count).End(xlUp).Row
If Last_Row >= Start_Row Then
    rLastRow = rWS.Range("A" & Rows.Count).End(xlUp).Row + 1
    If rLastRow < rStartRow Then
        rLastRow = rStartRow
    End If
    
    Last_Col = ws3.Cells(Start_Row - 1, Columns.Count).End(xlToLeft).Column
    ws3.Range(ws3.Cells(Start_Row, 1), ws3.Cells(Last_Row, Last_Col)).Copy
    rWS.Range("A" & rLastRow).PasteSpecial xlPasteAll
    Application.CutCopyMode = False
End If
End Sub

 

[dmt32]

Hi,
Try replacing lines that end xlPasteAll

rWS.Range("A" & rLastRow).PasteSpecial xlPasteAll

with xlPasteValues

rWS.Range("A" & rLastRow).PasteSpecial xlPasteValues

and see if this does what you want

Dave

 

[Jbgs14]

Awesome That works thank you!