How to avoid a sheet when we run a macro combines data from many sheets into a single sheet

Question

I am new to macro, but have some basic idea how it works or like able to write small VBA codes.

Is it possible to avoid more than 1 sheets when i use below macro which actually copy data from different sheets to one sheet called Import

VBA CODE

Option Explicit
Public Sub CombineDataFromAllSheets()

Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
Dim Strname As String

'Notes: "Src" is short for "Source", "Dst" is short for "Destination"

'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("Import")
lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below (and in Toolbelt)!
lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below (and in Toolbelt)!

'Set the initial destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

'Loop through all sheets
For Each wksSrc In ThisWorkbook.Worksheets

    'Make sure we skip the "Import" destination sheet!
    Strname = UCase(wksSrc.Name)
    If Strname <> "Import" And _
    Strname <> "Import2" Then

        'Identify the last occupied row on this sheet
        lngSrcLastRow = LastOccupiedRowNum(wksSrc)

        'Store the source data then copy it to the destination range
        With wksSrc
            Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
            rngSrc.Copy Destination:=rngDst
        End With

        'Redefine the destination range now that new data has been added
        lngDstLastRow = LastOccupiedRowNum(wksDst)
        Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

    End If

Next wksSrc
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last column
'OUTPUT      : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    LastOccupiedColNum = lng
End Function

For example I have 5 sheets in an excel, they are

Sheet1. Control Sheet (more like a Dash board/UI)
Sheet2. Import (Where data need to be copied)
Sheet3. Comparison (No need to copy data from this sheet)
Sheet4. CSV file 1 (All data available will be copied to IMPORT sheet)
Sheet5. CSV file 2 (All data available will be copied to IMPORT sheet)

now when user run the query only data from sheet 5 and sheet 6 get copied to Sheet 2 (Import)

I used

Strname = UCase(wksSrc.Name)
If Strname <> "Import" And _
Strname <> "Comparison" And _ 
Strname <> "Control Sheet" Then

But this actually not working and just copy everything available under all 5 sheets.

Kindly help me on this.

Thanks in Advance

You converted the string to upper case so that if statement will always be true. — braX
either remove UCase or use upper case of all sheet names: If Strname <> "IMPORT" And _ Strname <> "COMPARISON" And _ Strname <> "CONTROL SHEET" Then — Ibo

Unknown Unknown · Accepted Answer · 2017-10-18T20:20:33

A Select Case statement are well suited for handling multiple comparisions to value.

    Select Case UCase(wksSrc.Name)
        Case UCase("Import"), UCase("Comparison"), UCase("Control Sheet")

        Case Else

    End Select

Here I use Filter for it's text comparison ability.

I prefer to pass the Source range to a helper function. This makes debugging very easy.

Public Sub CombineDataFromAllSheets2()
    Dim LastUsedCell As Range, ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        With ws
            If Filter(Array("Import", "Comparison", "Control Sheet"), .Name, True, vbTextCompare) = -1 Then

                Set LastUsedCell = getLastUsedCell(ws)
                If LastUsedCell Is Nothing Then
                    MsgBox "No Cells Found on Worksheet: " & ws.Name, vbInformation, "Worksheet Skipped"
                Else
                    ImportRange .Range(.Cells(2, 1), LastUsedCell)
                End If

            End If
        End With
    Next
End Sub

Public Sub ImportRange(Source As Range)
    With ThisWorkbook.Worksheets("Import")
        With .Range("A" & .Rows.Count).End(xlUp)
            Source.Copy Destination:=.Offset(1)
        End With
    End With
End Sub

Public Function getLastUsedCell(ws As Worksheet) As Range
    Set getLastUsedCell = ws.Cells.Find(What:="*", After:=ws.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
End Function

How to avoid a sheet when we run a macro combines data from many sheets into a single sheet

1 Answers