lks55
04-01-2016, 08:19 AM
Hi,
I want to copy the whole file with formats. But i get this error, ones it arrives at the line
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
It is one of the last lines of this code. I tried everything but i don't know what to do. Please help me.
Option Explicit
Sub AddNew()
Dim s As Variant
Dim s5 As Long
Dim lastcell As Long
Dim MyFile As String
Dim directory As String
MsgBox "Please open a file to show the path of the regions"
s = Application.GetOpenFilename("Excel Workbook (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")
s = Left(s, InStrRev(s, "\"))
MyFile = Dir(s & "*.xl??")
Workbooks.Add
's = Application.GetSaveAsFilename("WK00 - UK Total", "Excel Files (*.xlsm), *.xlsm")
'ActiveWorkbook.SaveAs Filename:=s
Do While MyFile <> ""
Workbooks.Open (MyFile)
s5 = 4
Do While Cells(s5, 2) <> ""
s5 = s5 + 1
Loop
Range(Cells(3, 2), Cells(s5, 13)).Copy
ActiveWorkbook.Close
If Cells(1, 1) <> "" Then
ActiveCell.End(xlDown).Select
lastcell = ActiveCell.Row
Cells(lastcell + 1, 1).Select
End If
'ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
MyFile = Dir
Loop
End Sub
I want to copy the whole file with formats. But i get this error, ones it arrives at the line
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
It is one of the last lines of this code. I tried everything but i don't know what to do. Please help me.
Option Explicit
Sub AddNew()
Dim s As Variant
Dim s5 As Long
Dim lastcell As Long
Dim MyFile As String
Dim directory As String
MsgBox "Please open a file to show the path of the regions"
s = Application.GetOpenFilename("Excel Workbook (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")
s = Left(s, InStrRev(s, "\"))
MyFile = Dir(s & "*.xl??")
Workbooks.Add
's = Application.GetSaveAsFilename("WK00 - UK Total", "Excel Files (*.xlsm), *.xlsm")
'ActiveWorkbook.SaveAs Filename:=s
Do While MyFile <> ""
Workbooks.Open (MyFile)
s5 = 4
Do While Cells(s5, 2) <> ""
s5 = s5 + 1
Loop
Range(Cells(3, 2), Cells(s5, 13)).Copy
ActiveWorkbook.Close
If Cells(1, 1) <> "" Then
ActiveCell.End(xlDown).Select
lastcell = ActiveCell.Row
Cells(lastcell + 1, 1).Select
End If
'ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme
MyFile = Dir
Loop
End Sub