VBA macro: Iterating through all sheets, copying data range based on condition to master sheet

[Midday]

Context:

I am trying to set up a library of plants in Excel that I can select and see their state throughout the year, so I know what plants to add to make a good-looking garden.
The moment I press the button, that I included in the Master sheet, I want the Master sheet to show the plants I selected in the various other sheets . However, it should only copy some of the cells, as not all info is relevant for the overview.

Problem: I have little experience with excel and none with VBA or macros. I tried various methods/formulas found on the web, but I eventually get stuck because it doesn’t work entirely for what I need, and I miss the knowledge to adapt the code.


What should happen on button press:

• Clear Master sheet of previous entries starting from A6.
• Iterate through all the sheets except “Master”.
• Search each sheet for not empty cells in Column A, starting from row 3 to exclude headers.
  • Column A is used to select plants with x. To be more flexible I’d like the macro to search for any value, hence the not empty/blank.
• If not empty, then copy column range C to AB from that row to the master sheet.
  • I don't need the selection indicator (column A) or the image (column B) only the rest needs to be copied

I included an example file as well to make it clearer, it has a macro with bits and pieces of code that I collected: https://easyupload.io/893scx

I hope someone can help me out or point me in the right direction.


Thanks in advance for looking at this!

 

[mumps]

Try:

Sub CopySelectedPlants()
    Application.ScreenUpdating = False
    Dim LastRow As Long, desWS As Worksheet, ws As Worksheet, x As Long: x = 1
    Set desWS = Sheets("Master")
    With desWS
        .UsedRange.Offset(5).ClearContents
        .UsedRange.Offset(5).Interior.ColorIndex = xlNone
        .Rows.AutoFit
    End With
    For Each ws In Sheets(Array("Perennials", "Trees"))
        With ws
            .ListObjects(x).Range.AutoFilter Field:=1, Criteria1:="<>"
            .AutoFilter.Range.Offset(1, 2).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
            .Range("A2").AutoFilter
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[Midday]

Try:

Sub CopySelectedPlants()
    Application.ScreenUpdating = False
    Dim LastRow As Long, desWS As Worksheet, ws As Worksheet, x As Long: x = 1
    Set desWS = Sheets("Master")
    With desWS
        .UsedRange.Offset(5).ClearContents
        .UsedRange.Offset(5).Interior.ColorIndex = xlNone
        .Rows.AutoFit
    End With
    For Each ws In Sheets(Array("Perennials", "Trees"))
        With ws
            .ListObjects(x).Range.AutoFilter Field:=1, Criteria1:="<>"
            .AutoFilter.Range.Offset(1, 2).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
            .Range("A2").AutoFilter
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub

Thanks! It almost works perfectly. The only thing it didn’t copy is info that was in a collapsed group. (Which wasn't clear as it seems I uploaded one image twice instead of the plant sheet -.- )

Because it missed that info it copied the cells in the wrong place in the master sheet, as your code neatly places every cell after one another.

I added the correct image of the perennials sheet, highlighting the group that is normally collapsed which also needs to be copied. I also added an image of the result on the master sheet using the code you provided.


The iterating and filtering works and it also resets the sheet every time the code is run, those parts works great!

 

[mumps]

Try:

Sub CopySelectedPlants()
    Application.ScreenUpdating = False
    Dim LastRow As Long, desWS As Worksheet, ws As Worksheet, x As Long: x = 1
    Set desWS = Sheets("Master")
    With desWS
        .Columns("D:F").Cells.EntireColumn.Hidden = False
        .Columns("S:X").Cells.EntireColumn.Hidden = False
        .UsedRange.Offset(5).ClearContents
        .UsedRange.Offset(5).Interior.ColorIndex = xlNone
        .Rows.AutoFit
    End With
    For Each ws In Sheets(Array("Perennials", "Trees"))
        With ws
            .Columns("E").Cells.EntireColumn.Hidden = False
            .Columns("I:T").Cells.EntireColumn.Hidden = False
            .ListObjects(x).Range.AutoFilter Field:=1, Criteria1:="<>"
            .Range("C3", .Range("AB" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
            .Range("A2").AutoFilter
            .Columns("E").Cells.EntireColumn.Hidden = True
            .Columns("I:T").Cells.EntireColumn.Hidden = True
        End With
    Next ws
    With desWS
        .Columns("D:F").Cells.EntireColumn.Hidden = True
        .Columns("S:X").Cells.EntireColumn.Hidden = True
    End With
    Application.ScreenUpdating = True
End Sub

 

[Midday]

Try:

Sub CopySelectedPlants()
    Application.ScreenUpdating = False
    Dim LastRow As Long, desWS As Worksheet, ws As Worksheet, x As Long: x = 1
    Set desWS = Sheets("Master")
    With desWS
        .Columns("D:F").Cells.EntireColumn.Hidden = False
        .Columns("S:X").Cells.EntireColumn.Hidden = False
        .UsedRange.Offset(5).ClearContents
        .UsedRange.Offset(5).Interior.ColorIndex = xlNone
        .Rows.AutoFit
    End With
    For Each ws In Sheets(Array("Perennials", "Trees"))
        With ws
            .Columns("E").Cells.EntireColumn.Hidden = False
            .Columns("I:T").Cells.EntireColumn.Hidden = False
            .ListObjects(x).Range.AutoFilter Field:=1, Criteria1:="<>"
            .Range("C3", .Range("AB" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
            .Range("A2").AutoFilter
            .Columns("E").Cells.EntireColumn.Hidden = True
            .Columns("I:T").Cells.EntireColumn.Hidden = True
        End With
    Next ws
    With desWS
        .Columns("D:F").Cells.EntireColumn.Hidden = True
        .Columns("S:X").Cells.EntireColumn.Hidden = True
    End With
    Application.ScreenUpdating = True
End Sub

Works like a charm! I have been banging my head against a wall for days, I can't believe you solved it so quickly. Thanks for the help, I highly appreciate it!

 

[mumps]

You are very welcome.