Combine only visible worsheets into one

[Achtig]

I'm using the below code to combine all worksheets, however, I only want the visible worksheets to combine, not the hidden ones. How can I change the code to do this?
Each sheet has it's own name, right now it combines all sheets from 2 through 16.

Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Name"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To 16
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A500000").End(xlUp)(2)
Next
End Sub

 

[Roderick_E]

The code doesn't appear to loop through a workbook's sheets.

Sub WorksheetLoop2()


         ' Declare Current as a worksheet object variable.
         Dim Current As Worksheet


         ' Loop through all of the worksheets in the active workbook.
         For Each Current In Worksheets
[COLOR=#ff0000]if Current.visible = true then 'only visible sheets[/COLOR]
            ' Insert your code here.
            ' This line displays the worksheet name in a message box.
            MsgBox Current.Name
[COLOR=#ff0000]endif[/COLOR]
         Next


      End Sub

 

[Domenic]

Similar to Roderick's solution...

[COLOR=darkblue]Sub[/COLOR] Combine()

    [COLOR=darkblue]Dim[/COLOR] wksDest [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] wks [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] strSheetName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] Cnt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=green]'Assign the sheet name to a variable (change the sheet name accordingly)[/COLOR]
    strSheetName = "YourSheetName"
    
    [COLOR=green]'Delete any pre-existing worksheet[/COLOR]
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
    Application.DisplayAlerts = [COLOR=darkblue]False[/COLOR]
    Worksheets(strSheetName).Delete
    Application.DisplayAlerts = [COLOR=darkblue]True[/COLOR]
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
    
    [COLOR=green]'Add a new worksheet at the beginning of the workbook[/COLOR]
    [COLOR=darkblue]Set[/COLOR] wksDest = Worksheets.Add(before:=Sheets(1))
    
    [COLOR=green]'Name the new worksheet[/COLOR]
    wksDest.Name = strSheetName
    
    [COLOR=green]'Copy the data from visible worksheets to the newly created worksheet[/COLOR]
    Cnt = 0
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] wks [COLOR=darkblue]In[/COLOR] Worksheets
        [COLOR=darkblue]If[/COLOR] wks.Name <> wksDest.Name [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]If[/COLOR] wks.Visible = xlSheetVisible [COLOR=darkblue]Then[/COLOR]
                Cnt = Cnt + 1
                [COLOR=darkblue]If[/COLOR] Cnt = 1 [COLOR=darkblue]Then[/COLOR]
                    wks.Rows(1).Copy wksDest.Range("A1") [COLOR=green]'copy header row[/COLOR]
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
                [COLOR=darkblue]With[/COLOR] wks.Range("A1").CurrentRegion
                    .Offset(1, 0).Resize(.Rows.Count - 1).Copy wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp)(2)
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] wks
    
End [COLOR=darkblue]Sub[/COLOR]

Hope this helps!

 

[Achtig]

Hi Domenic,
Your solution works perfect, thank you for the help on this problem.

Maybe you can assist in another issue I'm having in the same worksheets, I posted a thread earlier, see link below, but did not get another reply after the first response did not work. I think the MATCH formula doesn’t work, since it only gives me an exact match, I need it to look further down the column and return the first value not "At Sea”. Maybe you could have a look at it?

https://www.mrexcel.com/forum/excel...value-if-certain-text-exists-lookup-cell.html

Maybe I need a VBA for that as well? Any help is much appreciated.

Thanks