简体   繁体   中英

VBA Copy Multiple Worksheets into One

I found this code below to help combine multiple sheets of data into one, however, it won't take from multiple sheets. I have two sheets and it either grabs one or the other. I tried to add on to it to specify more than one sheet but that doesn't seem to work either. How can I make this pull from multiple sheets? I have a sheet "anaheim" and sheet "Woodridge."

 Sub Step3()

    Dim i As Long
    Dim xRg As Range

    On Error Resume Next

    Worksheets.Add Sheets(1)

    ActiveSheet.Name = "MasterSheet"
For i = 2 To Sheets.Count
        Set xRg = Sheets(1).UsedRange

        If i > 2 Then
            Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1)
        End If

        Sheets(i).Activate
        ActiveSheet.UsedRange.Copy xRg
        
        
    Next

End Sub

Backup Used Ranges

Option Explicit

Sub backupUsedRanges()

    ' Target Worksheet
    Const tgtSheetName As String = "MasterSheet"
    Const tgtFirstCell As String = "A1"
    ' Workbook
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    ' Check if a sheet named 'tgtSheetName' already exists.
    Dim Msg As Variant
    If SheetExists(wb, tgtSheetName) Then
        Msg = MsgBox("A sheet named '" & tgtSheetName _
                   & "' already exists. Do you want to delete it?", _
                     vbYesNo + vbExclamation, "Delete?")
        If Msg = vbYes Then
            Application.DisplayAlerts = False
            wb.Worksheets(tgtSheetName).Delete
            Application.DisplayAlerts = True
        Else
            MsgBox "Backup NOT created.", vbExclamation, "Fail"
            Exit Sub
        End If
    End If
    
    ' Define (add) Target Worksheet ('tgt').
    Dim tgt As Worksheet
    Set tgt = wb.Worksheets.Add(Before:=wb.Sheets(1))
    tgt.Name = tgtSheetName
    
    ' Define Next Target First Available Cell Range ('cel').
    Dim cel As Range
    Set cel = tgt.Range(tgtFirstCell)
    
    ' Write from Source Worksheets ('src') to Target Worksheet.
    Dim src As Worksheet ' Current Source Worksheet
    Dim rng As Range     ' Current Source Used Range
    For Each src In wb.Worksheets
        If StrComp(src.Name, tgtSheetName, vbTextCompare) <> 0 Then
            ' Define Current Source Used Range ('rng').
            Set rng = src.UsedRange
            ' Copy Current Source Used Range to Target Worksheet.
            rng.Copy cel
            ' Define Next Target First Available Cell Range.
            Set cel = cel.Offset(rng.Rows.Count)
        End If
    Next src

    ' Inform user
    MsgBox "Backup created.", vbInformation, "Success"
    
End Sub

Function SheetExists(Book As Workbook, SheetName As String) As Boolean
    Dim sh As Object
    For Each sh In Book.Sheets
        If StrComp(sh.Name, SheetName, vbTextCompare) = 0 Then
            SheetExists = True
            Exit Function
        End If
    Next sh
End Function
Sub Step3()
    
    Dim sh          As Worksheet
    Dim xRg         As Range
    
    Sheets.Add.Name = "MasterSheet"
    For Each sh In Sheets
        If sh.Name <> "MasterSheet" Then
            sh.UsedRange.Copy Sheets("MasterSheet").Cells(Sheets("MasterSheet").Rows.Count, "A").End(xlUp).Offset(1)
        End If
    Next
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM