Advanced Search

Return to Snippet

Revision: 60877
at November 15, 2012 05:54 by angelia
Initial Code 
'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
Initial URL 

                                

                                                            

                                    

                                        

                                        Initial Description
                                        

                                    

                                    
'Append data from multiple worksheet to single worksheet macro

                                

                                                            

                                    

                                        

                                        Initial Title
                                        

                                    

                                    
'Append data from multiple worksheet to single worksheet macro

                                

                                                            

                                    

                                        

                                        Initial Tags
                                        

                                    

                                    
excel

                                

                                                            

                                    

                                        

                                        Initial Language
                                        

                                    

                                    
Visual Basic