I have a code, that copies sheets from one workbook to another. The code looks like this:

Sub CopyShees()
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(worksheets.count)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

And it actually works. But I like it to skip the sheets in the Activeworkbook, that already exist in ThisWorkbook, so it only copies "new" sheets from the active workbook.

I have treid different approaches but with no succes so far. Anybody?

Hi Jan,

Am Thu, 10 Sep 2020 14:22:53 -0700 (PDT) schrieb Jan Kronsell:

I have a code, that copies sheets from one workbook to another. The code looks like this:

[code snipped]

And it actually works. But I like it to skip the sheets in the Activeworkbook, that already exist in ThisWorkbook, so it only copies "new" sheets from the active workbook.

try:

Option Explicit
Public wbk As String

Sub CopySheets()
Dim myPath As String
Dim FN As String
Dim wsh As Worksheet
Dim shCount As Integer

wbk = ThisWorkbook.Name
'Modify the sheet name
myPath = ThisWorkbook.Sheets("Sheet1").Range("H1")
FN = Dir(myPath & "*.xlsm")
Do While FN < ""
shCount = ThisWorkbook.Sheets.Count
Workbooks.Open (myPath & FN)
For Each wsh In ActiveWorkbook.Worksheets
If SheetExists(wsh.Name) = False Then
wsh.Copy After:=ThisWorkbook.Sheets(shCount)
End If
Next wsh
Workbooks(FN).Close
FN = Dir()
Loop
End Sub

Function SheetExists(strShName As String) As Boolean
On Error Resume Next
SheetExists = Not Workbooks(wbk).Sheets(strShName) Is Nothing
End Function


Regards
Claus B.
--
Windows10
Office 2016

Hi Claus

Sorry for my late reply, but I have been on a business trip. Your solution works soothly. Thank you.

Regards
Jan