Adding Sheets

[KlausW]

Hi, is it possible to get Excel to import the tabs only once, no matter how many times I run the code. That is if new tabs are added.

Any help will be much appreciated.
Many Thanks
Klaus W

Sub Rektangelafrundedehjørner1_Klik()

Dim SS As Integer
SS = Sheets.Count

Path = Range("h1")

Filename = Dir(Path & "*.xlsm")

Do While Filename <> ""

Workbooks.Open Filename:=Path & Filename, ReadOnly:=True

For Each Sheet In ActiveWorkbook.Sheets

Sheet.Copy After:=ThisWorkbook.Sheets(SS)

Next Sheet

Workbooks(Filename).Close

Filename = Dir()

Loop

End Sub

 

[Fluff]

How about

Sub KlausW()
   Dim Ws As Worksheet
   Dim Wbk As Workbook
   Dim Pth As String, Fname As String
   
   Pth = Range("h1").Value
   Fname = Dir(Pth & "*.xlsm")
   Do While Fname <> ""
      Set Wbk = Workbooks.Open(Pth & Fname)
      For Each Ws In Wbk.WorkSheets
         If Not ShtExists(Ws.Name, Wbk) Then
            Ws.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
         End If
      Next Ws
      Wbk.Close False
      Fname = Dir
   Loop
End Sub

and

Public Function ShtExists(ShtName As String, Optional Wbk As Workbook) As Boolean
    If Wbk Is Nothing Then Set Wbk = ActiveWorkbook
    On Error Resume Next
    ShtExists = (LCase(Wbk.Sheets(ShtName).Name) = LCase(ShtName))
    On Error GoTo 0
End Function

 

[KlausW]

Hi Fluff
Excel don't import any sheets/tabs with this code.

KW

 

[Fluff]

Oops, it should be

Sub KlausW()
   Dim ws As Worksheet
   Dim Wbk As Workbook
   Dim Pth As String, Fname As String
   
   Pth = Range("h1").Value
   Fname = Dir(Pth & "*.xlsm")
   Do While Fname <> ""
      Set Wbk = Workbooks.Open(Pth & Fname)
      For Each ws In Wbk.WorkSheets
         If Not ShtExists(ws.Name, ThisWorkbook) Then
            ws.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
         End If
      Next ws
      Wbk.Close False
      Fname = Dir
   Loop
End Sub

 

[KlausW]

It works thanks a lot.
KW

 

[Fluff]

You're welcome & thanks for the feedback.