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
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.