Hi Folks,
Following a work laptop refresh I've lost the LET and VSTACK functions and am unlikely to get it back until our IT Department decides to update (whenever that may be).
Therefore, I'm trying to come up with a solution to achieve the extraction of data from several sheets in to one. A search on the web has provided me with this VBA solution from Data Cycle Analytics which goes some way to helping me achieve my objective. However, rather than looping through all sheets, As it will ultimately be part of a much bigger workbook, I want to be able to specify the names of the sheets where the data will be extracted from.
For example. Where it says "If Left(sht.name, 1) = 4 Then". I want to be able to provide the actual sheet name(s) (e.g. I only want to extract data from sheets "4R Class" and "4Y Class").
I'm looking for help with the code to help me specify the sheet names.
Sub CombineWorksheets()
Dim DestinationSht As Worksheet 'This is the master worksheet where others will be combined
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim LastDestRow As Long
Dim SourceLastRow As Long 'this identifies last occupied row in the input worksheets
Dim SourceLastColWithData As Long 'This is standard for this example
Dim RangeToCopy As Range
Dim ClassSize As Long 'Defines how many students are in a class
'We don't want our program to slow down, thus we put off screen updating
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set DestinationSht = ThisWorkbook.Worksheets("Combined")
With DestinationSht
'Get column headers from first worksheet
ThisWorkbook.Worksheets("4R Class").Range("B4:L5").Copy _
Destination:=DestinationSht.Range("B4:L5")
'We define the first row where data will be pasted in the destination worksheet
LastDestRow = DestinationSht.Cells(DestinationSht.Rows.Count, "B").End(xlUp).Row
End With
'loop through all the worksheets
For Each sht In ThisWorkbook.Worksheets
If Left(sht.Name, 1) = 4 Then 'Our source worksheets start with a 4. We wish to skip other worksheets
'Identify the last occupied row. We use column B that has the student names
SourceLastRow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row 'MsgBox SourceLastRow //You can use this line to check whether the rows returned are correct
SourceLastColWithData = 12 'In all the worksheets, column L (= #12) is the last column with data
With sht
Set RangeToCopy = .Range(.Cells(6, 2), .Cells(SourceLastRow, SourceLastColWithData))
RangeToCopy.Copy _
Destination:=DestinationSht.Range("B" & LastDestRow + 1)
DestinationSht.Range("A5").Value = "Class" 'Column heading to identify the data sets once pasted
DestinationSht.Range("A" & LastDestRow + 1).Value = sht.Name
'Get the last used row in the adjacent column B in the destination sheet, and fill the data accordingly in column A
DestinationSht.Range("A" & LastDestRow + 1).AutoFill Destination:=Range("A" & LastDestRow + 1 & ":A" & Range("B" & Rows.Count).End(xlUp).Row)
End With
End If
LastDestRow = DestinationSht.Cells(DestinationSht.Rows.Count, "B").End(xlUp).Row
Next sht
' Call AutoFit on the destination sheet so that all data is readable.
DestinationSht.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Thanks in advance
Bookmarks