Macro shortcut keys not work properly
 

I added to my macro a shortcut key & for some reason it oprate only part of my macro. If anyone familiar with this kind of problem, I would like a solution

This is my macro


' Ctrl+Shift+T shortcu

Sub FindSheets(
Dim FName As Strin
Dim WB As Workboo
Const FOLDER_NAME = "C:\Temp" '<<--CHANG

ChDrive FOLDER_NAM
ChDir FOLDER_NAM
FName = Dir("*.xls"
Workbooks.Add ' New W
Application.DisplayAlerts = False ' Disable delete alert
Sheets("Sheet3").Select 'Delete sheet #3 in new W
ActiveWindow.SelectedSheets.Delet
Sheets("Sheet2").Select 'Delete sheet #2 in new W
ActiveWindow.SelectedSheets.Delet
Application.DisplayAlerts = True ' Enable delete alert
ChDir "C:\Documents and Settings\mlunker\Desktop" ' Save new W
ActiveWorkbook.SaveAs Filename:=
"C:\Documents and Settings\mlunker\Desktop\TempName.xls", FileFormat:=
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
, CreateBackup:=Fals
Application.DisplayAlerts = Tru
Do Until FName = "" ' copy sheet
Set WB = Workbooks.Open(Filename:=FName
ActiveSheet.Selec
n = Workbooks("TempName.xls").Sheets.Coun
ActiveSheet.Copy After:=Workbooks("TempName.xls").Sheets(n
WB.Close SaveChanges:=Tru
FName = Dir(
Loo
Windows("TempName.xls").Activat
Application.DisplayAlerts = False ' Disable delete alert
Sheets("Sheet1").Select 'Delete sheet #2 in new W
ActiveWindow.SelectedSheets.Delet
Application.CutCopyMode = Fals
ActiveWorkbook.Sav
Application.DisplayAlerts = True ' Enable delete alert
End Su

Thanks
Mata

Macro shortcut keys not work properly
 

Try changing the shortcut key combination so it doesn't include a Shift.

--
Regards,
Tom Ogilvy


"Matan" wrote in message
...
I added to my macro a shortcut key & for some reason it oprate only part
of my macro. If anyone familiar with this kind of problem, I would like a
solution.

This is my macro:

'
' Ctrl+Shift+T shortcut
'
Sub FindSheets()
Dim FName As String
Dim WB As Workbook
Const FOLDER_NAME = "C:\Temp" '<<--CHANGE

ChDrive FOLDER_NAME
ChDir FOLDER_NAME
FName = Dir("*.xls")
Workbooks.Add ' New WB
Application.DisplayAlerts = False ' Disable delete alerts
Sheets("Sheet3").Select 'Delete sheet #3 in new WB
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet2").Select 'Delete sheet #2 in new WB
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True ' Enable delete alerts
ChDir "C:\Documents and Settings\mlunker\Desktop" ' Save new WB
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\mlunker\Desktop\TempName.xls",
FileFormat:= _
xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.DisplayAlerts = True
Do Until FName = "" ' copy sheets
Set WB = Workbooks.Open(Filename:=FName)
ActiveSheet.Select
n = Workbooks("TempName.xls").Sheets.Count
ActiveSheet.Copy After:=Workbooks("TempName.xls").Sheets(n)
WB.Close SaveChanges:=True
FName = Dir()
Loop
Windows("TempName.xls").Activate
Application.DisplayAlerts = False ' Disable delete alerts
Sheets("Sheet1").Select 'Delete sheet #2 in new WB
ActiveWindow.SelectedSheets.Delete
Application.CutCopyMode = False
ActiveWorkbook.Save
Application.DisplayAlerts = True ' Enable delete alerts
End Sub

Thanks,
Matan