VBA copy data from workbook to another based on criteria

Question

I have 2 workbooks, one source workbook with data spread over different sheets, and one target workbook where this data needs to be copied to, on one single sheet, right below each other.

The copying of the data from the source to the target is based on a criteria which is the name of the sheet from the source workbook. And based on this criteria a specific copy method (which is a specific order of columns) should be used to copy the data to the target workbook.

For example here below I have a sheet "apple" on the source workbook, when this criteria is met, a specific order of columns should be copied to the target sheet.

And there below on the target sheet comes a different copy method for banana and so on.

This is what I have so far, but it doesn't work:

Public wbsource As Workbook, wbtarget As Workbook

'to get to the point for this question I have left out the folder picker subs

Sub SelectSourceandSearchforSheets()

wbsource.Activate

'activate and copy

Dim sourcesheet As Worksheet

Dim lastrow As String


For Each sourcesheet In Application.ActiveWorkbook.Worksheets
          
    Select Case CopyPaste
        Case Is = "apple"
            sourcesheet.Select
            
'copy column 1 source to column 1 target which is the apple copy method
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Copy

wbtarget.Worksheets("worksheet").Select
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & lastrow).Select
Selection.PasteSpecial
'etc
            
        Case Is = "banana"
            sourcesheet.Select

'copy column 2 source to column 1 target which is the banana copy method
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Copy

wbtarget.Worksheets("worksheet").Select
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & lastrow).Select
Selection.PasteSpecial
'etc

    End Select
    
    Next

End Sub

I need help with :

• I'm not sure if the implemented loop, cycles through the sheets of the source workbook for matching apple, babnana etc one by one

• Did I use correctly the "Select Case" function or should I use an "If then" function, or something different?

• Did I use correctly the "last row" function to put the copied data below each other on the working sheet?

Answer 1

Way too much use of Select/Activate (see this thread), preferably no use of it at all if possible.
Select case needs the value to compare, i.e. sourcesheet.Name. However, in your case, it doesn't seem necessary to use it unless you have similar orders for multiple sheets, i.e. "banana" has the same order of columns as "onion". I'll use this in my example of how your code could look like.

As for the lastrow, use one for sourcesheet (to avoid the select issue) and a second one for the destination sheet and declare it as Long, not String. When working with different sheets, you can also use the worksheet variable to avoid more activations, i.e. sourcesheet.Range("A" & lastrow).

Option Explicit

Public wbsource As Workbook, wbtarget As Workbook

'to get to the point for this question I have left out the folder picker subs

Sub SelectSourceandSearchforSheets()
    
    Dim sourcesheet As Worksheet
    Dim lastrow As Long, lRowS As Long, i As Long
    Dim arr
    Dim targetSheet As Worksheet
    Set targetSheet = wbtarget.Worksheets("worksheet")
    Dim rngS As Range, rngD As Range
    For Each sourcesheet In wbsource.Worksheets
        Select Case sourcesheet.Name
            Case "apple", "carrot"
                arr = Array(4, 2, 1, 3, 5) 'order of columns
            Case "banana", "onion"
                arr = Array(1, 3, 2, 4, 5)
            Case Else
                GoTo skipNext
        End Select
        
        lRowS = sourcesheet.Cells(sourcesheet.Rows.Count, "A").End(xlUp).Row
        lastrow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
        If lRowS > 1 Then 'in case there's no data below the "ColumnX"-row
            For i = 0 To UBound(arr)
                Set rngS = sourcesheet.Range(sourcesheet.Cells(2, arr(i)), sourcesheet.Cells(lRowS, arr(i)))
                Set rngD = targetSheet.Range("A" & lastrow).Resize(lRowS - 1).Offset(, i)
                rngD.Value = rngS.Value 'no need for copy paste in your case
                'you could instantly pass over the values without setting the variables but that'd be less easy to read
            Next i
        End If
skipNext:
    Next sourcesheet

End Sub

Hope that helps!