CODEWITHSUNDEEP
excelvba
Royce
Royce

Reputation: 1595

How to copy values from sheets to another sheet?

I'm trying to merge several sheets into one.

Configuration

DataSheet1 : First sheet
DataSheet2 : Second sheet
ConsolidatedSheet : Consolidated sheet

Code

Set consolidatedSheet = Worksheets("ConsolidatedSheet")
consolidatedSheet.Activate

startRow = 2
startCol = 1

Worksheets("DataSheet1").Activate
lastRow = Cells(Rows.Count, startCol).End(xlUp).row
lastCol = Cells(startRow, Columns.Count).End(xlToLeft).Column
Range(Cells(startRow, startCol), Cells(lastRow, lastCol)).Copy _
consolidatedSheet.Range("A" & consolidatedSheet.Cells(Rows.Count, 1).End(xlUp).row + 1)

Worksheets("DataSheet2").Activate
lastRow = Cells(Rows.Count, startCol).End(xlUp).row
lastCol = Cells(startRow, Columns.Count).End(xlToLeft).Column
Range(Cells(startRow, startCol), Cells(lastRow, lastCol)).Copy _
consolidatedSheet.Range("A" & consolidatedSheet.Cells(Rows.Count, 1).End(xlUp).row + 1)

Issue

Two arrays are created in the consolidated sheet. It means I can't sort on the consolidated sheet.

How do I copy data as values instead of arrays?

Upvotes: 0

Views: 117

Answers (2)

Алексей Р
Алексей Р

Reputation: 7627

Sub consSheets()
    Dim ws As Worksheet
    With Worksheets("ConsolidatedSheet")
        .Cells.Delete   ' clear the assignment sheet first
        For Each ws In Sheets(Array("DataSheet1", "DataSheet2"))
            ws.Cells(2, 1).CurrentArray.Copy
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        Next ws
    End With
    Application.CutCopyMode = False ' "clears" the clipboard
End Sub

Edit2: (not copy headers from DataSheet1 and DataSheet2 and keep existing header in ConsolidatedSheet)

Sub consSheets()
    Dim ws As Worksheet
    With Worksheets("ConsolidatedSheet")
        .Rows("2:" & .UsedRange.Row + .UsedRange.Rows.Count).Delete ' clear (without header in Row 1) the assignment sheet first
        
        For Each ws In Sheets(Array("DataSheet1", "DataSheet2"))
            Set Rng = ws.Cells(2, 1).CurrentRegion
            Set Rng = Intersect(Rng, Rng.Offset(1)) ' eliminate headers
            
            If Not Rng Is Nothing Then
                Rng.Copy
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
            End If
        Next ws
    End With
    Application.CutCopyMode = False ' "clears" the clipboard
End Sub

Upvotes: 1

Dave Scott
Dave Scott

Reputation: 153

I'm not sure what you mean by it creating arrays, and I don't think that code is actually the code using as it's not doing what you describe.

But here's something that does what your intending.

Option Explicit
Sub Test()
    
    Dim cSht As Worksheet
    Set cSht = Worksheets("ConsolidatedSheet")
    
    Dim StartRow As Integer, StartCol As Integer
    StartRow = 1
    StartCol = 1
    
    'Split out to a sub and don't need to repeat self
    Call ConsolidateData(cSht, "DataSheet1", StartRow, StartCol, True)
    Call ConsolidateData(cSht, "DataSheet2", StartRow, StartCol)
    
End Sub

Private Sub ConsolidateData(cSht As Worksheet, FromSheet As String, StartRow As Integer, StartCol As Integer, Optional IncludeHeader As Boolean)
    
    Dim FromRow As Integer
    If IncludeHeader Then
        FromRow = StartRow
    Else
        FromRow = StartRow + 1
    End If
    
    With Worksheets(FromSheet)
        lastrow = .Cells(.Rows.Count, StartCol).End(xlUp).Row
        lastcol = .Cells(StartRow, .Columns.Count).End(xlToLeft).Column
        
        'Just transfering value is faster then copy, but doesn't bring formatting
        cSht.Cells(cSht.Rows.Count, 1).End(xlUp).Resize(lastrow - FromRow, lastcol - StartCol).Value2 = .Range(.Cells(FromRow, StartCol), .Cells(lastrow, lastcol)).Value2
        
    End With

End Sub

Upvotes: 1

Related Questions