This error has been bugging me out for a while now and while running the macros individually, they always work. Since it was a bit of a work to run 10 macros individually, I decided to compile them into one module and can be run on a click of a form button. After doing that, I've been getting this error on the ActiveSheet.Paste for all of the macros. Any help would be appreciated. Thank you.
Sub ItemCode()
'
' AutoFilter Macro
' Scan itemCode
Dim WB As Workbook
Set WB = ActiveWorkbook
ActiveSheet.Range("C1").AutoFilter Field:=3, Criteria1:=Array("#DIV/0!", "#N/A", "#Ref", "Null"), Operator:=xlFilterValues
If Range("C1").End(xlDown).Value = "" Then
Call CustCode
Else
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("SampleFile.xlsx").Activate
ActiveWorkbook.Sheets.Add.Name = "ItemCode"
Worksheets("ItemCode").Activate
ActiveSheet.Paste
Windows("ABF_Sample.xlsx").Activate
Application.CutCopyMode = False
Selection.AutoFilter
Application.StatusBar = "20% Completed"
End If
End Sub
Note: SampleFile.xlsx was declared in another macro.
Try this code. You will need to change the workbook and sheet names in the code to suit. It's always best to declare your workbooks and sheet names to avoid problems with pasting values in the wrong place. It also means you don't have to activate workbooks and worksheets which really slows down you code.
Sub ItemCode()
'
' AutoFilter Macro
' Scan itemCode
Dim WB1 As Workbook
Set WB1 = Workbooks("ABF_Sample")
Dim WS1 As Worksheet
Set WS1 = WB.Sheets("Sheet1")
Dim FilePath As String
Dim Filename As String
FilePath = "enter your file path here"
Filename = "SampleFile"
Dim WB2 As Workbook
Set WB2 = Workbooks.Add
ActiveWorkbook.SaveAs (FilePath & Filename & ".xlsx")
WS1.Range("C1").AutoFilter Field:=3, Criteria1:=Array("#DIV/0!", "#N/A", "#Ref", "Null"), Operator:=xlFilterValues
If WS.Range("C1").End(xlDown).Value = "" Then
Call CustCode
Else
WS1.UsedRange.Copy
With Workbooks(Filename)
.Sheets.Add.Name = "ItemCode"
.Sheets("ItemCode").Range("A1").PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
Selection.AutoFilter
Application.StatusBar = "20% Completed"
End If
End Sub
Related
I am modifying my current code to be more user friendly. My original code had hard coded file paths. The new code below is passing the file paths from a "control" sub where they are designated by an input box. The issue I am having is that now, once in the private sub routine, the If statements are no longer working. The only difference is that the file path is being passed from another sub instead of being hardcoded into this sub. I'm not sure what I am missing. Any help would be great.
Private Sub copyGLbuildings(NewRecPath As String, GLsrcPath As String)
Dim fname1 As Variant
Dim fname2 As Variant
Dim wb1 As Workbook
Dim Wb0 As Workbook
fname1 = Dir(GLsrcPath & "*Buildings*")
fname2 = Dir(NewRecPath & "*Buildings Rec*")
If fname1 <> "" Then
Set wb1 = Workbooks.Open(GLsrcPath & fname1)
End If
If fname2 <> "" Then
Set Wb0 = Workbooks.Open(NewRecPath & fname2)
End If
Wb0.Sheets(1).Name = "Data"
Wb0.Sheets.Add.Name = "GL"
wb1.Worksheets(1).UsedRange.Copy
Wb0.Worksheets("GL").UsedRange.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Wb0.Worksheets("GL").UsedRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Wb0.Worksheets("GL").UsedRange.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Wb0.Worksheets(1).Activate
ActiveWorkbook.Windows(1).DisplayGridlines = False
Call CleanFAGL
wb1.Close
Wb0.Close savechanges:=True
End Sub
The code looks fine to me. I would advise you put a break point right on the first If Statement and use View > Locals to check what the values of NewRecPath and GLsrcPath are being passed into the Sub Routine as.
Copy to Another Workbook
Using the Destination (written to) before the Source (read from) as the argument is quite unusual.
fname is better written like fName.
Neither of the fNames are ever going to be "", since you have previously added the patterns.
wb0 is a horrible idea, at least start numbering with 1 in the spirit of Excel and VBA. Note that my choice of variable names is also not quite good, but only you can improve it since you fully understand what it's all about.
If it's a worksheet then call it a worksheet (readability) or at least be consistent.
After adding a worksheet without arguments, it will 'land' before the selected (active) sheet, so if you only have one sheet in the workbook, it will be the first. If it isn't, why would you gamble with it, if you can settle this explicitly?
Have a think about the order of the PasteSpecial lines e.g. you adjusted the column widths before the data was copied.
Using sheet or worksheet indexes is prone to errors and confusion which in this case leads me to not knowing which worksheet should be 'deprived' of displaying grid lines.
The rest is covered in your comments.
Don't worry, we all were at this point at one time.
Carefully read the comments and modify the code appropriately.
Option Explicit
' Note that the arguments are switched due to the 'From To' logic.
Private Sub copyGLbuildings( _
ByVal SourcePath As String, _
ByVal DestinationPath As String)
' Validate
' Destination
Dim dwbName As String: dwbName = Dir(DestinationPath & "*Buildings Rec*")
If dwbName = "" Then Exit Sub
' Source
Dim swbName As String: swbName = Dir(SourcePath & "*Buildings*")
If swbName = "" Then Exit Sub
'Application.ScreenUpdating = False
' Destination
' Workbook
If Right(dwbName, 1) <> "\" Then
dwbName = dwbName & "\"
End If
Dim dwb As Workbook: Set dwb = Workbooks.Open(DestinationPath & dwbName)
' Worksheets
Dim dws1 As Worksheet: Set dws1 = dwb.Worksheets(1)
dws1.Name = "Data"
Dim dws2 As Worksheet
' Do it explicitly, even if there is previously only one worksheet.
Set dws2 = dwb.Worksheets.Add(After:=dws1) ' ??? maybe Before:=dws1
dws2.Name = "GL"
' Source
If Right(swbName, 1) <> "\" Then
swbName = swbName & "\"
End If
Dim swb As Workbook: Set swb = Workbooks.Open(SourcePath & swbName)
' Copy
swb.Worksheets(1).UsedRange.Copy
' Destination
' Paste
With dws2.UsedRange
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteColumnWidths
End With
Application.CutCopyMode = False
' Dispay Gridlines
dws1.Activate ' ??? if "Data" or dws2.Activate ' if "GL": depending on After
dwb1.Windows(1).DisplayGridlines = False
CleanFAGL ' ??? Not knowing what this does, doesn't help.
Application.DisplayAlerts = False
swb.Close SaveChanges:=False
dwb.Close SaveChanges:=True
Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub
I have a macro in workbook A that calls a macro in workbook B. I want the macro in workbook B to run and then I want to close workbook B. I keep getting an error saying the macro cannot be found that I want to run from workbook B. I am pretty much a novice at this, but I have done a pretty thorough search and haven't been able to come up with anything on my own. Here is my code in it's entirety.
Public Sub InputDept()
Dim Cap As Workbook
Dim Cap2 As String
On Error Resume Next
Set Cap = Workbooks("NGD Source File for Net Budget Reporting.xlsx")
Cap2 = Cap.Name
On Error GoTo 0
Dim wb As Workbook
Dim Cap1 As Variant
Application.ScreenUpdating = False
If Cap Is Nothing Then
Cap1 = Application.GetOpenFilename("Excel Files(*.xl*)," & "*.xl*", 1)
If Cap1 = False Then
Exit Sub
End If
Set wb = Workbooks.Open(Cap1)
Cap2 = ActiveWorkbook.Name
Else
Workbooks(Cap2).Activate
End If
Sheets("Dept Summary").Activate
Cells.Find(What:="Direct", after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Dim cRng As Range
Dim dRng As Range
Set dRng = Selection
For Each cRng In dRng
If cRng.Interior.ThemeColor = xlThemeColorAccent3 Then
Dim mCalc As String
Dim mSum As Workbook
On Error Resume Next
Set mSum = Workbooks("Master Calc with Macro.xlsm")
mCalc = mSum.Name
On Error GoTo 0
Application.ScreenUpdating = False
If mSum Is Nothing Then
mSum1 = Application.GetOpenFilename("Excel Files.xl*),"& "*.xl*", 1)
If mSum1 = False Then
Exit Sub
End If
Set wb1 = Workbooks.Open(mSum1)
mCalc = ActiveWorkbook.Name
Else
Workbooks(mCalc).Activate
End If
cRng.Copy
Workbooks(mCalc).Activate
Sheets("Data").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Report").Activate
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
Sheets("Report").Select
ActiveSheet.Copy
Cells.Select
Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.SaveAs _
Filename:=Application.ThisWorkbook.Path & "\" & Format(Date - 28, "MMM") & " Files\" & Left(cRng, 7) & ".xlsx"
ActiveWorkbook.Close
Workbooks(mCalc).Close savechanges:=False
End If
Next cRng
End Sub
This line:
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
needs to be changed a little. You need to include the name of the workbook inside a single quotes, even if it looks like you are specifying the proper workbook with Workbooks(mCalc):
Workbooks(mCalc).Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
You can actually just shorten it to:
Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
If the macro you need to find relative macro path by using workbook path from which you run macro and you need to run several macros from the array list, the code below will help:
Dim relativePath As String, programFileName As String
Dim selectedProgramsFiles() As String, programsArrayLastIndex As Byte, I As Byte
For I = 0 To programsArrayLastIndex 'Loop through all selected programs
programFileName = selectedProgramsFiles(I)
relativePath = ThisWorkbook.Path & "\" & programFileName
Workbooks.Open Filename:=relativePath
Application.Run ("'" & relativePath & "'!ModuleName.Main")
Workbooks(programFileName).Activate
ActiveWorkbook.Close SaveChanges:=False
Next I 'For I = 0 To programsArrayLastIndex 'Loop through all selected program
Application.Run "PERSONAL.xlsb!ClearYellow", 0
ClearYellow is the name of the sub in Personal.xlsb that is being run.
The "0" is the first argument of this sub (would omit if no arguments, could add more arguments separated by commas)
Application does not seem to be needed
This could be used to run from some other workbook also; the workbook would have to be open; if the name of that workbook had a space in it, the name would have to be surrounded by ''
Call does not work cross workbooks; haven’t tested within same workbook or within same module
I have a macro in workbook A that calls a macro in workbook B. I want the macro in workbook B to run and then I want to close workbook B. I keep getting an error saying the macro cannot be found that I want to run from workbook B. I am pretty much a novice at this, but I have done a pretty thorough search and haven't been able to come up with anything on my own. Here is my code in it's entirety.
Public Sub InputDept()
Dim Cap As Workbook
Dim Cap2 As String
On Error Resume Next
Set Cap = Workbooks("NGD Source File for Net Budget Reporting.xlsx")
Cap2 = Cap.Name
On Error GoTo 0
Dim wb As Workbook
Dim Cap1 As Variant
Application.ScreenUpdating = False
If Cap Is Nothing Then
Cap1 = Application.GetOpenFilename("Excel Files(*.xl*)," & "*.xl*", 1)
If Cap1 = False Then
Exit Sub
End If
Set wb = Workbooks.Open(Cap1)
Cap2 = ActiveWorkbook.Name
Else
Workbooks(Cap2).Activate
End If
Sheets("Dept Summary").Activate
Cells.Find(What:="Direct", after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Dim cRng As Range
Dim dRng As Range
Set dRng = Selection
For Each cRng In dRng
If cRng.Interior.ThemeColor = xlThemeColorAccent3 Then
Dim mCalc As String
Dim mSum As Workbook
On Error Resume Next
Set mSum = Workbooks("Master Calc with Macro.xlsm")
mCalc = mSum.Name
On Error GoTo 0
Application.ScreenUpdating = False
If mSum Is Nothing Then
mSum1 = Application.GetOpenFilename("Excel Files.xl*),"& "*.xl*", 1)
If mSum1 = False Then
Exit Sub
End If
Set wb1 = Workbooks.Open(mSum1)
mCalc = ActiveWorkbook.Name
Else
Workbooks(mCalc).Activate
End If
cRng.Copy
Workbooks(mCalc).Activate
Sheets("Data").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Report").Activate
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
Sheets("Report").Select
ActiveSheet.Copy
Cells.Select
Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.SaveAs _
Filename:=Application.ThisWorkbook.Path & "\" & Format(Date - 28, "MMM") & " Files\" & Left(cRng, 7) & ".xlsx"
ActiveWorkbook.Close
Workbooks(mCalc).Close savechanges:=False
End If
Next cRng
End Sub
This line:
Workbooks(mCalc).Application.Run ("!SummarizeMaster")
needs to be changed a little. You need to include the name of the workbook inside a single quotes, even if it looks like you are specifying the proper workbook with Workbooks(mCalc):
Workbooks(mCalc).Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
You can actually just shorten it to:
Application.Run ("'Master Calc with Macro.xlsm'!SummarizeMaster")
If the macro you need to find relative macro path by using workbook path from which you run macro and you need to run several macros from the array list, the code below will help:
Dim relativePath As String, programFileName As String
Dim selectedProgramsFiles() As String, programsArrayLastIndex As Byte, I As Byte
For I = 0 To programsArrayLastIndex 'Loop through all selected programs
programFileName = selectedProgramsFiles(I)
relativePath = ThisWorkbook.Path & "\" & programFileName
Workbooks.Open Filename:=relativePath
Application.Run ("'" & relativePath & "'!ModuleName.Main")
Workbooks(programFileName).Activate
ActiveWorkbook.Close SaveChanges:=False
Next I 'For I = 0 To programsArrayLastIndex 'Loop through all selected program
Application.Run "PERSONAL.xlsb!ClearYellow", 0
ClearYellow is the name of the sub in Personal.xlsb that is being run.
The "0" is the first argument of this sub (would omit if no arguments, could add more arguments separated by commas)
Application does not seem to be needed
This could be used to run from some other workbook also; the workbook would have to be open; if the name of that workbook had a space in it, the name would have to be surrounded by ''
Call does not work cross workbooks; haven’t tested within same workbook or within same module
I'm looking to do the following:
CommandButton in a destination Worksheet opens a source file (dialog box to choose which one)
Finds a worksheet (always the same name - "Performance") within the source file
Copies a range of cells (actually a couple of separate ranges - to be added)
Makes sure destination sheet (which has the same name as cell I2 in source sheet) exists
Pastes values to same ranges in destination Worksheet
Closes source file
I have this so far:
Private Sub CommandButton1_Click()
Dim SourceFile As String
Dim SourceBook As Workbook
Dim DestinationBook As Workbook
Dim desiredName As String
Set DestinationBook = ThisWorkbook
SourceFile = Application.GetOpenFilename(fileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
Set SourceBook = Workbooks.Open(SourceFile)
SourceBook.Sheets("Performance").Activate
desiredName = ActiveSheet.Range("I2")
Application.CutCopyMode = True
SourceBook.ActiveSheet.Range("E25:I64").Copy
DestinationBook.Activate
If WorksheetExists = False Then
MsgBox "Couldn't find " & desiredName & " sheet within destination workbook"
Call SourceBook.Close(False)
Exit Sub
Else
Range("E25:I64").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Call SourceBook.Close(False)
End If
End Sub
Function WorksheetExists() As Boolean
Dim sh As Object
For Each sh In DestinationBook.Worksheets
If sh.Name = desiredName Then WorksheetExists = True: sh.Activate
Exit For
Next
End Function
I'm getting Run-time error '424': Object Required
Any suggestions...?
Thanks in advance!
Here is a modification of your latest code. Notice these additions: 1) "Option Explicit" ensures you've properly declared all variables, 2) variables have been assigned to the important workbooks, worksheets, and ranges, 3) needed variables are passed to the WorkSheetExists function. For this to work there should be sheets named "Performance" and "testSheet" in the DestinationBook, and "testSheet" in I2 of the SourceBook. Remember, that this is just an attempt to "get you going" so I expect you'll need to modify.
Option Explicit
Sub test()
Dim SourceFile As String
Dim SourceBook As Workbook, performanceSh As Worksheet
Dim DestinationBook As Workbook
Dim desiredName As String
Set DestinationBook = ThisWorkbook
SourceFile = Application.GetOpenFilename(fileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
Set SourceBook = Workbooks.Open(SourceFile)
Set performanceSh = SourceBook.Sheets("Performance")
desiredName = performanceSh.Range("I2")
Application.CutCopyMode = True
performanceSh.Range("E25:I64").Copy
If WorksheetExists(DestinationBook, desiredName) = False Then
MsgBox "Couldn't find " & desiredName & " sheet within destination workbook"
SourceBook.Close(False)
Exit Sub
Else
Range("E25:I64").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
SourceBook.Close(False)
End If
End Sub
Function WorksheetExists(destWk As Workbook, theName As String) As Boolean
Dim sh As Object
For Each sh In destWk.Worksheets
If sh.Name = theName Then WorksheetExists = True: sh.Activate
Exit For
Next
End Function
Suppose I have a workbook1.xlsm with multiple worksheets and full of various formulas. I want to create a new workbook2.xlsx which would look exactly the same as workbook1 but in all the cells would be values instead of formulas.
I have this macro to copy one sheet from workbook1:
Sub nowe()
Dim Output As Workbook
Dim FileName As String
Set Output = Workbooks.Add
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Przestoje").Cells.Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats
FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx"
Output.SaveAs FileName
End Sub
but the problem is it copies only one worksheet and does not name it like it was in worksheet1. I cannot figure it out.
Yet another problem is that worksheet2 is being opened afterwards. I do not want to do this.
How can I solve these problems?
I would do that as simply as possibly, without creating new workbook and copying sheets to it.
Few simple steps: taking into consideration thisworkbook >> for each worksheet within thisworkbook >> copy+paste values of used range within worksheet >> save as new workbook as xlsx type >> open back base workbook >> and finally close one we created.
The code will be simple and looks as follows:
Sub nowe_poprawione()
Dim Output As Workbook
Dim Current As String
Dim FileName As String
Set Output = ThisWorkbook
Current = ThisWorkbook.FullName
Application.DisplayAlerts = False
Dim SH As Worksheet
For Each SH In Output.Worksheets
SH.UsedRange.Copy
SH.UsedRange.PasteSpecial xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Next
FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx"
Output.SaveAs FileName, XlFileFormat.xlOpenXMLWorkbook
Workbooks.Open Current
Output.Close
Application.DisplayAlerts = True
End Sub
This should allow you to keep all the formatting, column widths, and only the values.
Option Explicit
Sub copyAll()
Dim Output As Workbook, Source As Workbook
Dim sh As Worksheet
Dim FileName As String
Dim firstCell
Application.ScreenUpdating = False
Set Source = ActiveWorkbook
Set Output = Workbooks.Add
Application.DisplayAlerts = False
Dim i As Integer
For Each sh In Source.Worksheets
Dim newSheet As Worksheet
' select all used cells in the source sheet:
sh.Activate
sh.UsedRange.Select
Application.CutCopyMode = False
Selection.Copy
' create new destination sheet:
Set newSheet = Output.Worksheets.Add(after:=Output.Worksheets(Output.Worksheets.Count))
newSheet.Name = sh.Name
' make sure the destination sheet is selected with the right cell:
newSheet.Activate
firstCell = sh.UsedRange.Cells(1, 1).Address
newSheet.Range(firstCell).Select
' paste the values:
Range(firstCell).PasteSpecial Paste:=xlPasteColumnWidths
Range(firstCell).PasteSpecial Paste:=xlPasteFormats
Range(firstCell).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Next
' delete the sheets that were originally there
While Output.Sheets.Count > Source.Worksheets.Count
Output.Sheets(1).Delete
Wend
FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx"
Output.SaveAs FileName
Output.Close
Application.ScreenUpdating = True
End Sub
Something like this would work to cycle through and copy all sheets after adding the workbook:
dim i as integer
For i = 1 To ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Activate
ThisWorkbook.Worksheets(i).Select
Cells.Copy
Output.Activate
Dim newSheet As Worksheet
Set newSheet = Output.Worksheets.Add()
newSheet.Name = ThisWorkbook.Worksheets(i).Name
newSheet.Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Next
Note that this doesn't handle removing default sheets that automatically get created when the workbook gets created.
Also, worksheet2 is actually being opened (though not named til SaveAs) as soon as you call this:
Set Output = Workbooks.Add
Just close it after saving:
Output.Close
Something like this would work to cycle through and copy all sheets after adding the workbook - it builds on mr.Reband's answer, but with a few bells and whistles. Among other things it will work if this is in a third workbook (or an add-in etc), it deletes the default sheet or sheets that were created, it ensures the order of the sheets is the same as the original, etc:
Option Explicit
Sub copyAll()
Dim Output As Workbook, Source As Workbook
Dim sh As Worksheet
Dim FileName As String
Dim firstCell
Application.ScreenUpdating = False
Set Source = ActiveWorkbook
Set Output = Workbooks.Add
Application.DisplayAlerts = False
Dim i As Integer
For Each sh In Source.Worksheets
Dim newSheet As Worksheet
' select all used cells in the source sheet:
sh.Activate
sh.UsedRange.Select
Application.CutCopyMode = False
Selection.Copy
' create new destination sheet:
Set newSheet = Output.Worksheets.Add(after:=Output.Worksheets(Output.Worksheets.Count))
newSheet.Name = sh.Name
' make sure the destination sheet is selected with the right cell:
newSheet.Activate
firstCell = sh.UsedRange.Cells(1, 1).Address
newSheet.Range(firstCell).Select
' paste the values:
Range(firstCell).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=False
Next
' delete the sheets that were originally there
While Output.Sheets.Count > Source.Worksheets.Count
Output.Sheets(1).Delete
Wend
FileName = ThisWorkbook.Path & "\" & "worksheet2.xlsx"
Output.SaveAs FileName
Output.Close
Application.ScreenUpdating = True
End Sub