The following code will take entries from column B on the 6 sheets and copy
them head-to-tail on the 7th sheet in column A. You can adjust the columns
used in the code. You'll need to set the sheet names in the code also, so
that they match the sheet names in your workbook. It processes all 6 sheets
at once, and it assumes no empty cells between entries in column B of the 6
sheets.
To insert the code: press [Alt]+[F11] to open the VB Editor. Use Insert |
Module in the VB Editor menu to insert a new code module, then copy the code
below and paste it into the code module. Close the VB Editor and use the
macro when you need to (after modifying the code for the workbook you put it
into). The CheckLists macro is the only one of these 2 that will show in
your macro list, and it's the one to choose to perform the operation.
Sub CheckLists()
'go thru all worksheets
'and if a sheet is one
'with list we want to copy
'then do so, but ignore
'any others, including the
'one (Sheet7) where the lists
'will be combined
Dim anySheet As Worksheet
Dim doItFlag As Boolean
'clear any older results
Worksheets("Sheet7").Cells.Clear
For Each anySheet In ThisWorkbook.Worksheets
'change the sheet names in the
'Case Is =
'statements as needed
'and add more Case Is = statements
'if you add more sheets to process
doItFlag = False
Select Case anySheet.Name
Case Is = "Sheet1"
doItFlag = True
Case Is = "Sheet2"
doItFlag = True
Case Is = "Sheet3"
doItFlag = True
Case Is = "Sheet4"
doItFlag = True
Case Is = "Sheet5"
doItFlag = True
Case Is = "Sheet6"
doItFlag = True
Case Else
'for any sheet not listed above
'leave doItFlag as False
End Select
If doItFlag Then
CombineLists anySheet
End If
Next
End Sub
Private Sub CombineLists(sourceSheet As Worksheet)
'this will copy entries from column B of sourceSheet
'into column A of destSheet (Sheet7)
'in head-to-tail fashion
'
'these constants control what columns are
'involved in the data copy
'change to use different columns
srcColStart = "B1"
destColStart = "A1"
'last used row on source sheet
Dim srcLastRow As Long
'last used row on destination sheet
Dim destLastRow As Long
Dim maxRows As Long
Dim destSheet As Worksheet
Dim srcOffset As Long
'change name of worksheet as needed
Set destSheet = ThisWorkbook.Worksheets("Sheet7")
If Val(Left(Application.Version, 2)) < 12 Then
'in pre-2007 Excel
maxRows = Rows.Count
Else
'in Excel 2007 (or later)
maxRows = Rows.countlarge
End If
destLastRow = destSheet.Range(destColStart).End(xlDown).Row
If destLastRow = maxRows Then
destLastRow = 0
End If
srcLastRow = sourceSheet.Range(srcColStart).End(xlDown).Row
If srcLastRow = maxRows Then
'nothing to copy, nothing entered
'above the last row on the sheet
Exit Sub
End If
For srcOffset = 0 To srcLastRow - 1
destSheet.Range(destColStart).Offset(destLastRow, 0).Value = _
sourceSheet.Range(srcColStart).Offset(srcOffset, 0).Value
destLastRow = destLastRow + 1
Next
End Sub