ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   If SheetExisit then (https://www.excelbanter.com/excel-programming/345523-if-sheetexisit-then.html)

Ctech[_47_]

If SheetExisit then
 

I've been getting some help on this macro, however I still can't get i
to work.
So I have now simplified it a bit.

WHAT THE MACRO IS TO DO

1. Open all the workbooks in the specified folder. (one at a time) (Fo
i = 1 To 850)
2. "If SheetExists("Sch 20", Aworkbook) Then"
3. If the Workbook contains a worksheet "Sch 20", then copy range..


PROBLEMS IS

2. "If SheetExists("Sch 20", Aworkbook) Then"

This part doesn't work. However I don't know why? Can it have somethin
to do with my error handler?



MACRO

Option Explicit

Sub GetCellsFromWorkbooks()
Dim Mnumb
Dim Aworkbook As Workbook
Dim AWorkbook3
Dim sFileBase As String
Dim sFilename As String
Dim i
Dim Mcount As Long



AWorkbook3 = ActiveWorkbook.Name
Mnumb = 102
Range("A8").Select

For i = 1 To 850

On Error GoTo Errorhandler

' Set active Cell to Costcenter number / budget pack number

ActiveCell.Value = Mnumb

' Folder

sFileBase = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
"Budget packs - Capital expenditure - comments\LBUD2\BFR " & _
Mnumb
sFilename = sFileBase & " bud v2.1.xls"

' Open Pack

Set Aworkbook = Workbooks.Open(Filename:=sFilename, UpdateLinks:=0)

' If the opened workbook, contains the specified sheet then do...

If SheetExists("Sch 20", Aworkbook) Then

Aworkbook.Sheets("Sch 20").Range("A1:E25").Select
Mcount = Selection.Count


Selection.Copy

' Go to workbook where the macro was ran, and paste range

Workbooks(AWorkbook3).ActiveCell.Offset(0, 1).Paste

ActiveCell.Offset(5, -1).Select


Aworkbook.Close
Application.CutCopyMode = False

End If

Mnumb = Mnumb + 1
Next i

Errorhandler:

Mnumb = Mnumb + 1

Resume

End Sub


'-----------------------------------------------------------------
Function SheetExists(Sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing)
On Error GoTo 0
End Functio

--
Ctec
-----------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...fo&userid=2774
View this thread: http://www.excelforum.com/showthread.php?threadid=48478


Norman Jones

If SheetExisit then
 
Hi Ctech,

Aworkbook.Sheets("Sch 20").Range("A1:E25").Select


It is not possible to make selections on a non-active sheet.

It is rarely necessary, or desirable to make selections, but if you wish to,
try activating the sheet first:

Aworkbook.Sheets("Sch 20").Activate

---
Regards,
Norman



"Ctech" wrote in message
...

I've been getting some help on this macro, however I still can't get it
to work.
So I have now simplified it a bit.

WHAT THE MACRO IS TO DO:

1. Open all the workbooks in the specified folder. (one at a time) (For
i = 1 To 850)
2. "If SheetExists("Sch 20", Aworkbook) Then"
3. If the Workbook contains a worksheet "Sch 20", then copy range..


PROBLEMS IS:

2. "If SheetExists("Sch 20", Aworkbook) Then"

This part doesn't work. However I don't know why? Can it have something
to do with my error handler?



MACRO:

Option Explicit

Sub GetCellsFromWorkbooks()
Dim Mnumb
Dim Aworkbook As Workbook
Dim AWorkbook3
Dim sFileBase As String
Dim sFilename As String
Dim i
Dim Mcount As Long



AWorkbook3 = ActiveWorkbook.Name
Mnumb = 102
Range("A8").Select

For i = 1 To 850

On Error GoTo Errorhandler

' Set active Cell to Costcenter number / budget pack number

ActiveCell.Value = Mnumb

' Folder

sFileBase = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
"Budget packs - Capital expenditure - comments\LBUD2\BFR " & _
Mnumb
sFilename = sFileBase & " bud v2.1.xls"

' Open Pack

Set Aworkbook = Workbooks.Open(Filename:=sFilename, UpdateLinks:=0)

' If the opened workbook, contains the specified sheet then do...

If SheetExists("Sch 20", Aworkbook) Then

Aworkbook.Sheets("Sch 20").Range("A1:E25").Select
Mcount = Selection.Count


Selection.Copy

' Go to workbook where the macro was ran, and paste range

Workbooks(AWorkbook3).ActiveCell.Offset(0, 1).Paste

ActiveCell.Offset(5, -1).Select


Aworkbook.Close
Application.CutCopyMode = False

End If

Mnumb = Mnumb + 1
Next i

Errorhandler:

Mnumb = Mnumb + 1

Resume

End Sub


'-----------------------------------------------------------------
Function SheetExists(Sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing)
On Error GoTo 0
End Function


--
Ctech
------------------------------------------------------------------------
Ctech's Profile:
http://www.excelforum.com/member.php...o&userid=27745
View this thread: http://www.excelforum.com/showthread...hreadid=484789




Ctech[_48_]

If SheetExisit then
 

It works now..


Option Explicit

Sub GetCellsFromWorkbooks()
Dim Mnumb
Dim Aworkbook As Workbook
Dim AWorkbook3
Dim sFileBase As String
Dim sFilename As String
Dim i
Dim Mcount As Long



AWorkbook3 = ActiveWorkbook.Name
Mnumb = 102
Range("A8").Select

For i = 1 To 850

On Error GoTo Errorhandler

' Set active Cell to Costcenter number / budget pack number

ActiveCell.Value = Mnumb

' Folder

sFileBase = "X:\Users\Shared\GENERAL\Christian S\05.10.28 - " & _
"Budget packs - Capital expenditure - comments\LBUD2\BFR " & _
Mnumb
sFilename = sFileBase & " bud v2.1.xls"

' Open Pack

Set Aworkbook = Workbooks.Open(Filename:=sFilename, UpdateLinks:=0)



' If the opened workbook, contains the specified sheet then do...

If SheetExists("Sch 20", Aworkbook) Then

Aworkbook.Sheets("Sch 20").Activate
Aworkbook.Sheets("Sch 20").Range("A1:E25").Select
Mcount = Selection.Rows.Count


Selection.Copy

' Go to workbook where the macro was ran, and paste range

Application.Workbooks(AWorkbook3).Activate
ActiveCell.Offset(0, 1).PasteSpecial Paste:=xlValues
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False



End If
ActiveCell.Offset(Mcount, -1).Select
Application.CutCopyMode = False
Aworkbook.Close




Mnumb = Mnumb + 1
Next i

Errorhandler:
Application.CutCopyMode = False


Mnumb = Mnumb + 1

Resume Next

End Sub


'-----------------------------------------------------------------
Function SheetExists(Sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing)
On Error GoTo 0
End Functio

--
Ctec
-----------------------------------------------------------------------
Ctech's Profile: http://www.excelforum.com/member.php...fo&userid=2774
View this thread: http://www.excelforum.com/showthread.php?threadid=48478



All times are GMT +1. The time now is 07:11 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com