Hi Marcopone,
I have created the below to work outside of the source and destination workbooks as an example for you, i have defined the source and destination workbooks at the top of the code. There are probably more efficient ways of doing this but the below may get you and the other contributors started.
Hope this helpsSub test() Dim sCol As New Collection, dCol As New Collection Dim wbS As Workbook, wbD As Workbook, ws As Worksheet Dim MakeNew As Boolean, ToClear As Boolean, a, b Set wbS = Workbooks.Open("C:\Users\clarkg\Desktop\test\Source.xlsx") ' source wb Set wbD = Workbooks.Open("C:\Users\clarkg\Desktop\test\Destination.xlsx") ' destination wb For Each ws In wbS.Worksheets ' collection of source wb sheet names sCol.Add ws.Name, CStr(ws.Name) Next ws For Each ws In wbD.Worksheets ' collection of destination wb sheet names dCol.Add ws.Name, CStr(ws.Name) Next ws For Each a In sCol ' loop to move data and create sheet if needed For Each b In dCol If a = b Then wbS.Sheets(a).Rows("1:13").Copy wbD.Sheets(a).Rows(1).PasteSpecial xlAll Application.CutCopyMode = False MakeNew = False Exit For Else MakeNew = True End If Next b If MakeNew Then With wbD .Sheets.Add , .Sheets(.Sheets.Count) .ActiveSheet.Name = a wbS.Sheets(a).Rows("1:13").Copy .Sheets(a).Rows(1).PasteSpecial xlAll End With Application.CutCopyMode = False End If Next a For Each b In dCol ' loop to check for numeric sheet name in wbD and clear the rows if not in wbS For Each a In sCol If a <> b And IsNumeric(b) Then ToClear = True Else ToClear = False End If Next a If ToClear Then wbD.Sheets(b).Rows("1:13").ClearContents End If Next b wbD.Close True ' close source workbook wbS.Close False ' close destination workbook End Sub




Reply With Quote