Skipping sheets when copying
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? |
Skipping sheets when copying
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 |
Skipping sheets when copying
Hi Claus
Sorry for my late reply, but I have been on a business trip. Your solution works soothly. Thank you. Regards Jan |
All times are GMT +1. The time now is 12:52 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com