Posted By

angelia on 11/15/12

Tagged

excel

Versions (?)

Last Edited at 11/15/12 05:54am

Statistics

Viewed 677 times

Favorited by 0 user(s)

Related snippets

'Append data from multiple worksheet to single worksheet macro

/ Published in: Visual Basic

'Append data from multiple worksheet to single worksheet macro

Highlighted TextExpand

'Append data from multiple worksheet to single worksheet macro
Sub CombineData()

Dim wksFirst As Worksheet
    Dim wksLast As Worksheet
    Dim wksDest As Worksheet
    Dim strFirstSht As String
    Dim strLastSht As String
    Dim strDestSht As String
    Dim NextRow As Long
    Dim i As Long
    
    strFirstSht = "Sheet1" 'change the name of the first sheet accordingly
    strLastSht = "Sheet2" 'change the name of the last sheet accordingly
    strDestSht = "Combined Data" 'change the name of the destination sheet accordingly
    
    On Error Resume Next
    Set wksFirst = Worksheets(strFirstSht)
    If wksFirst Is Nothing Then
        MsgBox strFirstSht & " does not exist...", vbInformation
        Exit Sub
    Else
        Set wksLast = Worksheets(strLastSht)
        If wksLast Is Nothing Then
            MsgBox strLastSht & " does not exist...", vbInformation
            Exit Sub
        End If
    End If
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(strDestSht).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set wksDest = Worksheets.add(Worksheets(1))
    
    wksDest.Name = strDestSht
    
    For i = wksFirst.Index To wksLast.Index
        Worksheets(i).Range("A1:H89").Copy
        With wksDest
            NextRow = .Cells(.Rows.count, "A").End(xlUp).row + 1
            With .Cells(NextRow, "A")
                .PasteSpecial Paste:=8 'column width for Excel 2000 and later
                .PasteSpecial Paste:=xlPasteValues
                .PasteSpecial Paste:=xlPasteFormats
            End With
        End With
    Next i
    
    wksDest.Cells(1).Select
    
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True
    
End Sub

Report this snippet Tweet

Comments

Subscribe to comments

Comment:

You need to login to post a comment.

Posted By

Tagged

Versions (?)

Statistics

Related snippets

'Append data from multiple worksheet to single worksheet macro

Comments

Choose a language for easy browsing: