Get rid of all displaypagebreaks in whole workbook
 

I have a sub (with the help of y'all) that lets the user choose multiple
excel files to open, then it loops through each file and copies sheets 1 and
2 from it to a base workbook.

The one thing I am having problems with is I am getting an error that stops
the sub in its tracks. I THINK it is happening because sheet 2 of each
workbook that it copies from is displaying pagebreaks. Does this sound
correct?

I have it set to turn pagebreaks off on the activesheet (sheet 1) when it
opens the file, but I can not get it to turn pagebreaks off on the 2nd sheet.
Can you please help?

Thanks!



Sub m02_GetData()
' This Sub uses 4 functions:
' 1. Private Declare Function SetCurrentDirectoryA (at top of module)
' 2. Public Sub ChDirNet(szPath As String)
' 3. Function LastRow(sh As Worksheet)
' 4. Function LastCol(sh As Worksheet)
' Opens each Order Status Spreadsheet in succession and copies to blank
template
'
'
MsgBox " SELECT ALL FILES AT ONCE" & vbNewLine &
vbNewLine & vbNewLine _
& "Hello," & vbNewLine & "A browse dialog will now open." & vbNewLine &
vbNewLine _
& " 1. Please select the FIVE Order Status files at once,
using SHIFT or CTRL, and click OK." & vbNewLine & vbNewLine _
& " 2. Remember, always IGNORE the international file named
""IN..." & vbNewLine & vbNewLine & vbNewLine
On Error GoTo ErrorHandler

Dim SaveDriveDir As String
Dim MyPath As String 'Dim FilesInPath As String
Dim MyFiles() As Variant
Dim SourceRcount1, SourceRcount2 As Long
Dim Fnum As Long
Dim basebook, mybook As Workbook
Dim sourceRange1, sourceRange2 As Range
Dim destrange1, destrange2 As Range
Dim rnum1, rnum2 As Long
Dim lrow1, lrow2 As Long
Dim lcol1, lcol2 As Long

SaveDriveDir = CurDir

'Fill in the path\folder where the files are
'on your machine : MyPath = "C:\Data" or on a network :
ChDirNet "\\Server1\StatusFolder\Order_Status"


MyFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", MultiSelect:=True)

MsgBox "Hello," & vbNewLine & vbNewLine _
& "This program will now copy data from all five files to the new Blend
file. "

If IsArray(MyFiles) Then
Application.ScreenUpdating = False

Set basebook = ActiveWorkbook
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
rnum1 = 1
rnum2 = 1

On Error GoTo ErrorHandler 'CleanUp

'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)

Set mybook = Workbooks.Open(MyFiles(Fnum))

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False





These next four lines are my unsuccessful attempt to take pagebreaks off
sheet 2
Set ActiveSheet = ActiveWorkbook.Sheets(2)
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
Set ActiveSheet = mybook.Worksheets(1)






lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName
'mybook.Worksheets(2).Range(mybook.Worksheets(2).C ells(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

Set sourceRange1 =
mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, 1),
mybook.Worksheets(1).Cells(lrow1, lcol1))
''Set sourceRange1 = mybook.Worksheets(1).Range(Cells(1, 1),
Cells(lrow1, lcol1))
'Set sourceRange1 = mybook.Worksheets(1).Range("A1:AA" & lrow1)
Set sourceRange2 =
mybook.Worksheets(2).Range(mybook.Worksheets(2).Ce lls(1, 1),
mybook.Worksheets(2).Cells(lrow2, lcol2))
''Set sourceRange2 = mybook.Worksheets(2).Range(Cells(1, 1),
Cells(lrow2, lcol2))
'Set sourceRange2 = mybook.Worksheets(2).Range("A1:AA" & lrow2)
SourceRcount1 = sourceRange1.Rows.Count
SourceRcount2 = sourceRange2.Rows.Count
Set destrange1 = basebook.Worksheets(1).Range("A" & rnum1)
Set destrange2 = basebook.Worksheets(2).Range("A" & rnum2)

sourceRange1.Copy destrange1
sourceRange2.Copy destrange2
' Instead of this line you can use the code below to copy only
the values

' With sourceRange
' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
'
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

rnum1 = rnum1 + SourceRcount1
rnum2 = rnum2 + SourceRcount2

'Dim ExcelFileNameRange As Range
'Dim ExcelFileName As String

'ExcelFileName = mybook.Name
'With basebook
' ExcelFileNameRange = basebook.Cells(rnum1, "W")
'End With
' ExcelFileNameRange.Text = ExcelFileName


mybook.Close savechanges:=False
Next Fnum
Else: Exit Sub
Exit Sub
End If

CleanUp:
Application.ScreenUpdating = True
ChDirNet SaveDriveDir

ErrorHandlerNext:
Exit Sub

ErrorHandler:
Err.Raise 1001
'MsgBox "Error " & Err.Number & "; " & Err.Description
'Resume ErrorHandlerNext

End Sub

Get rid of all displaypagebreaks in whole workbook
 

The ON ERROR statement is causing the macro to stop. Lets not guess at what
is causing the error. Simply comment out the ON ERROR statement and run the
macro. The code will stop on the error and then you can find the source of
the problem.

"justme" wrote:

I have a sub (with the help of y'all) that lets the user choose multiple
excel files to open, then it loops through each file and copies sheets 1 and
2 from it to a base workbook.

The one thing I am having problems with is I am getting an error that stops
the sub in its tracks. I THINK it is happening because sheet 2 of each
workbook that it copies from is displaying pagebreaks. Does this sound
correct?

I have it set to turn pagebreaks off on the activesheet (sheet 1) when it
opens the file, but I can not get it to turn pagebreaks off on the 2nd sheet.
Can you please help?

Thanks!



Sub m02_GetData()
' This Sub uses 4 functions:
' 1. Private Declare Function SetCurrentDirectoryA (at top of module)
' 2. Public Sub ChDirNet(szPath As String)
' 3. Function LastRow(sh As Worksheet)
' 4. Function LastCol(sh As Worksheet)
' Opens each Order Status Spreadsheet in succession and copies to blank
template
'
'
MsgBox " SELECT ALL FILES AT ONCE" & vbNewLine &
vbNewLine & vbNewLine _
& "Hello," & vbNewLine & "A browse dialog will now open." & vbNewLine &
vbNewLine _
& " 1. Please select the FIVE Order Status files at once,
using SHIFT or CTRL, and click OK." & vbNewLine & vbNewLine _
& " 2. Remember, always IGNORE the international file named
""IN..." & vbNewLine & vbNewLine & vbNewLine
On Error GoTo ErrorHandler

Dim SaveDriveDir As String
Dim MyPath As String 'Dim FilesInPath As String
Dim MyFiles() As Variant
Dim SourceRcount1, SourceRcount2 As Long
Dim Fnum As Long
Dim basebook, mybook As Workbook
Dim sourceRange1, sourceRange2 As Range
Dim destrange1, destrange2 As Range
Dim rnum1, rnum2 As Long
Dim lrow1, lrow2 As Long
Dim lcol1, lcol2 As Long

SaveDriveDir = CurDir

'Fill in the path\folder where the files are
'on your machine : MyPath = "C:\Data" or on a network :
ChDirNet "\\Server1\StatusFolder\Order_Status"


MyFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", MultiSelect:=True)

MsgBox "Hello," & vbNewLine & vbNewLine _
& "This program will now copy data from all five files to the new Blend
file. "

If IsArray(MyFiles) Then
Application.ScreenUpdating = False

Set basebook = ActiveWorkbook
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
rnum1 = 1
rnum2 = 1

On Error GoTo ErrorHandler 'CleanUp

'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)

Set mybook = Workbooks.Open(MyFiles(Fnum))

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False





These next four lines are my unsuccessful attempt to take pagebreaks off
sheet 2
Set ActiveSheet = ActiveWorkbook.Sheets(2)
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
Set ActiveSheet = mybook.Worksheets(1)






lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName
'mybook.Worksheets(2).Range(mybook.Worksheets(2).C ells(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

Set sourceRange1 =
mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, 1),
mybook.Worksheets(1).Cells(lrow1, lcol1))
''Set sourceRange1 = mybook.Worksheets(1).Range(Cells(1, 1),
Cells(lrow1, lcol1))
'Set sourceRange1 = mybook.Worksheets(1).Range("A1:AA" & lrow1)
Set sourceRange2 =
mybook.Worksheets(2).Range(mybook.Worksheets(2).Ce lls(1, 1),
mybook.Worksheets(2).Cells(lrow2, lcol2))
''Set sourceRange2 = mybook.Worksheets(2).Range(Cells(1, 1),
Cells(lrow2, lcol2))
'Set sourceRange2 = mybook.Worksheets(2).Range("A1:AA" & lrow2)
SourceRcount1 = sourceRange1.Rows.Count
SourceRcount2 = sourceRange2.Rows.Count
Set destrange1 = basebook.Worksheets(1).Range("A" & rnum1)
Set destrange2 = basebook.Worksheets(2).Range("A" & rnum2)

sourceRange1.Copy destrange1
sourceRange2.Copy destrange2
' Instead of this line you can use the code below to copy only
the values

' With sourceRange
' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
'
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

rnum1 = rnum1 + SourceRcount1
rnum2 = rnum2 + SourceRcount2

'Dim ExcelFileNameRange As Range
'Dim ExcelFileName As String

'ExcelFileName = mybook.Name
'With basebook
' ExcelFileNameRange = basebook.Cells(rnum1, "W")
'End With
' ExcelFileNameRange.Text = ExcelFileName


mybook.Close savechanges:=False
Next Fnum
Else: Exit Sub
Exit Sub
End If

CleanUp:
Application.ScreenUpdating = True
ChDirNet SaveDriveDir

ErrorHandlerNext:
Exit Sub

ErrorHandler:
Err.Raise 1001
'MsgBox "Error " & Err.Number & "; " & Err.Description
'Resume ErrorHandlerNext

End Sub

Get rid of all displaypagebreaks in whole workbook
 

Hi Joel,

It is error 438; Object does not support this property or method. Can you
tell me what to do next?

Thanks!


"Joel" wrote:

The ON ERROR statement is causing the macro to stop. Lets not guess at what
is causing the error. Simply comment out the ON ERROR statement and run the
macro. The code will stop on the error and then you can find the source of
the problem.

"justme" wrote:

I have a sub (with the help of y'all) that lets the user choose multiple
excel files to open, then it loops through each file and copies sheets 1 and
2 from it to a base workbook.

The one thing I am having problems with is I am getting an error that stops
the sub in its tracks. I THINK it is happening because sheet 2 of each
workbook that it copies from is displaying pagebreaks. Does this sound
correct?

I have it set to turn pagebreaks off on the activesheet (sheet 1) when it
opens the file, but I can not get it to turn pagebreaks off on the 2nd sheet.
Can you please help?

Thanks!



Sub m02_GetData()
' This Sub uses 4 functions:
' 1. Private Declare Function SetCurrentDirectoryA (at top of module)
' 2. Public Sub ChDirNet(szPath As String)
' 3. Function LastRow(sh As Worksheet)
' 4. Function LastCol(sh As Worksheet)
' Opens each Order Status Spreadsheet in succession and copies to blank
template
'
'
MsgBox " SELECT ALL FILES AT ONCE" & vbNewLine &
vbNewLine & vbNewLine _
& "Hello," & vbNewLine & "A browse dialog will now open." & vbNewLine &
vbNewLine _
& " 1. Please select the FIVE Order Status files at once,
using SHIFT or CTRL, and click OK." & vbNewLine & vbNewLine _
& " 2. Remember, always IGNORE the international file named
""IN..." & vbNewLine & vbNewLine & vbNewLine
On Error GoTo ErrorHandler

Dim SaveDriveDir As String
Dim MyPath As String 'Dim FilesInPath As String
Dim MyFiles() As Variant
Dim SourceRcount1, SourceRcount2 As Long
Dim Fnum As Long
Dim basebook, mybook As Workbook
Dim sourceRange1, sourceRange2 As Range
Dim destrange1, destrange2 As Range
Dim rnum1, rnum2 As Long
Dim lrow1, lrow2 As Long
Dim lcol1, lcol2 As Long

SaveDriveDir = CurDir

'Fill in the path\folder where the files are
'on your machine : MyPath = "C:\Data" or on a network :
ChDirNet "\\Server1\StatusFolder\Order_Status"


MyFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", MultiSelect:=True)

MsgBox "Hello," & vbNewLine & vbNewLine _
& "This program will now copy data from all five files to the new Blend
file. "

If IsArray(MyFiles) Then
Application.ScreenUpdating = False

Set basebook = ActiveWorkbook
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
rnum1 = 1
rnum2 = 1

On Error GoTo ErrorHandler 'CleanUp

'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)

Set mybook = Workbooks.Open(MyFiles(Fnum))

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False





These next four lines are my unsuccessful attempt to take pagebreaks off
sheet 2
Set ActiveSheet = ActiveWorkbook.Sheets(2)
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
Set ActiveSheet = mybook.Worksheets(1)






lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName
'mybook.Worksheets(2).Range(mybook.Worksheets(2).C ells(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

Set sourceRange1 =
mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, 1),
mybook.Worksheets(1).Cells(lrow1, lcol1))
''Set sourceRange1 = mybook.Worksheets(1).Range(Cells(1, 1),
Cells(lrow1, lcol1))
'Set sourceRange1 = mybook.Worksheets(1).Range("A1:AA" & lrow1)
Set sourceRange2 =
mybook.Worksheets(2).Range(mybook.Worksheets(2).Ce lls(1, 1),
mybook.Worksheets(2).Cells(lrow2, lcol2))
''Set sourceRange2 = mybook.Worksheets(2).Range(Cells(1, 1),
Cells(lrow2, lcol2))
'Set sourceRange2 = mybook.Worksheets(2).Range("A1:AA" & lrow2)
SourceRcount1 = sourceRange1.Rows.Count
SourceRcount2 = sourceRange2.Rows.Count
Set destrange1 = basebook.Worksheets(1).Range("A" & rnum1)
Set destrange2 = basebook.Worksheets(2).Range("A" & rnum2)

sourceRange1.Copy destrange1
sourceRange2.Copy destrange2
' Instead of this line you can use the code below to copy only
the values

' With sourceRange
' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
'
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

rnum1 = rnum1 + SourceRcount1
rnum2 = rnum2 + SourceRcount2

'Dim ExcelFileNameRange As Range
'Dim ExcelFileName As String

'ExcelFileName = mybook.Name
'With basebook
' ExcelFileNameRange = basebook.Cells(rnum1, "W")
'End With
' ExcelFileNameRange.Text = ExcelFileName


mybook.Close savechanges:=False
Next Fnum
Else: Exit Sub
Exit Sub
End If

CleanUp:
Application.ScreenUpdating = True
ChDirNet SaveDriveDir

ErrorHandlerNext:
Exit Sub

ErrorHandler:
Err.Raise 1001
'MsgBox "Error " & Err.Number & "; " & Err.Description
'Resume ErrorHandlerNext

End Sub

Get rid of all displaypagebreaks in whole workbook
 

Which line of code

"justme" wrote:

Hi Joel,

It is error 438; Object does not support this property or method. Can you
tell me what to do next?

Thanks!


"Joel" wrote:

The ON ERROR statement is causing the macro to stop. Lets not guess at what
is causing the error. Simply comment out the ON ERROR statement and run the
macro. The code will stop on the error and then you can find the source of
the problem.

"justme" wrote:

I have a sub (with the help of y'all) that lets the user choose multiple
excel files to open, then it loops through each file and copies sheets 1 and
2 from it to a base workbook.

The one thing I am having problems with is I am getting an error that stops
the sub in its tracks. I THINK it is happening because sheet 2 of each
workbook that it copies from is displaying pagebreaks. Does this sound
correct?

I have it set to turn pagebreaks off on the activesheet (sheet 1) when it
opens the file, but I can not get it to turn pagebreaks off on the 2nd sheet.
Can you please help?

Thanks!



Sub m02_GetData()
' This Sub uses 4 functions:
' 1. Private Declare Function SetCurrentDirectoryA (at top of module)
' 2. Public Sub ChDirNet(szPath As String)
' 3. Function LastRow(sh As Worksheet)
' 4. Function LastCol(sh As Worksheet)
' Opens each Order Status Spreadsheet in succession and copies to blank
template
'
'
MsgBox " SELECT ALL FILES AT ONCE" & vbNewLine &
vbNewLine & vbNewLine _
& "Hello," & vbNewLine & "A browse dialog will now open." & vbNewLine &
vbNewLine _
& " 1. Please select the FIVE Order Status files at once,
using SHIFT or CTRL, and click OK." & vbNewLine & vbNewLine _
& " 2. Remember, always IGNORE the international file named
""IN..." & vbNewLine & vbNewLine & vbNewLine
On Error GoTo ErrorHandler

Dim SaveDriveDir As String
Dim MyPath As String 'Dim FilesInPath As String
Dim MyFiles() As Variant
Dim SourceRcount1, SourceRcount2 As Long
Dim Fnum As Long
Dim basebook, mybook As Workbook
Dim sourceRange1, sourceRange2 As Range
Dim destrange1, destrange2 As Range
Dim rnum1, rnum2 As Long
Dim lrow1, lrow2 As Long
Dim lcol1, lcol2 As Long

SaveDriveDir = CurDir

'Fill in the path\folder where the files are
'on your machine : MyPath = "C:\Data" or on a network :
ChDirNet "\\Server1\StatusFolder\Order_Status"


MyFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", MultiSelect:=True)

MsgBox "Hello," & vbNewLine & vbNewLine _
& "This program will now copy data from all five files to the new Blend
file. "

If IsArray(MyFiles) Then
Application.ScreenUpdating = False

Set basebook = ActiveWorkbook
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
rnum1 = 1
rnum2 = 1

On Error GoTo ErrorHandler 'CleanUp

'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)

Set mybook = Workbooks.Open(MyFiles(Fnum))

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False





These next four lines are my unsuccessful attempt to take pagebreaks off
sheet 2
Set ActiveSheet = ActiveWorkbook.Sheets(2)
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
Set ActiveSheet = mybook.Worksheets(1)






lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName
'mybook.Worksheets(2).Range(mybook.Worksheets(2).C ells(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

Set sourceRange1 =
mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, 1),
mybook.Worksheets(1).Cells(lrow1, lcol1))
''Set sourceRange1 = mybook.Worksheets(1).Range(Cells(1, 1),
Cells(lrow1, lcol1))
'Set sourceRange1 = mybook.Worksheets(1).Range("A1:AA" & lrow1)
Set sourceRange2 =
mybook.Worksheets(2).Range(mybook.Worksheets(2).Ce lls(1, 1),
mybook.Worksheets(2).Cells(lrow2, lcol2))
''Set sourceRange2 = mybook.Worksheets(2).Range(Cells(1, 1),
Cells(lrow2, lcol2))
'Set sourceRange2 = mybook.Worksheets(2).Range("A1:AA" & lrow2)
SourceRcount1 = sourceRange1.Rows.Count
SourceRcount2 = sourceRange2.Rows.Count
Set destrange1 = basebook.Worksheets(1).Range("A" & rnum1)
Set destrange2 = basebook.Worksheets(2).Range("A" & rnum2)

sourceRange1.Copy destrange1
sourceRange2.Copy destrange2
' Instead of this line you can use the code below to copy only
the values

' With sourceRange
' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
'
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

rnum1 = rnum1 + SourceRcount1
rnum2 = rnum2 + SourceRcount2

'Dim ExcelFileNameRange As Range
'Dim ExcelFileName As String

'ExcelFileName = mybook.Name
'With basebook
' ExcelFileNameRange = basebook.Cells(rnum1, "W")
'End With
' ExcelFileNameRange.Text = ExcelFileName


mybook.Close savechanges:=False
Next Fnum
Else: Exit Sub
Exit Sub
End If

CleanUp:
Application.ScreenUpdating = True
ChDirNet SaveDriveDir

ErrorHandlerNext:
Exit Sub

ErrorHandler:
Err.Raise 1001
'MsgBox "Error " & Err.Number & "; " & Err.Description
'Resume ErrorHandlerNext

End Sub

Get rid of all displaypagebreaks in whole workbook
 

It doesn't tell me which line, but if I rem out:
Set ActiveSheet = ActiveWorkbook.Sheets(2)
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
Set ActiveSheet = mybook.Worksheets(1)

The code runs all the way through. The only thing is I get the filenames ok
for anything on sheet 1, but nothing for sheet 2


"Joel" wrote:

Which line of code

"justme" wrote:

Hi Joel,

It is error 438; Object does not support this property or method. Can you
tell me what to do next?

Thanks!


"Joel" wrote:

The ON ERROR statement is causing the macro to stop. Lets not guess at what
is causing the error. Simply comment out the ON ERROR statement and run the
macro. The code will stop on the error and then you can find the source of
the problem.

"justme" wrote:

I have a sub (with the help of y'all) that lets the user choose multiple
excel files to open, then it loops through each file and copies sheets 1 and
2 from it to a base workbook.

The one thing I am having problems with is I am getting an error that stops
the sub in its tracks. I THINK it is happening because sheet 2 of each
workbook that it copies from is displaying pagebreaks. Does this sound
correct?

I have it set to turn pagebreaks off on the activesheet (sheet 1) when it
opens the file, but I can not get it to turn pagebreaks off on the 2nd sheet.
Can you please help?

Thanks!



Sub m02_GetData()
' This Sub uses 4 functions:
' 1. Private Declare Function SetCurrentDirectoryA (at top of module)
' 2. Public Sub ChDirNet(szPath As String)
' 3. Function LastRow(sh As Worksheet)
' 4. Function LastCol(sh As Worksheet)
' Opens each Order Status Spreadsheet in succession and copies to blank
template
'
'
MsgBox " SELECT ALL FILES AT ONCE" & vbNewLine &
vbNewLine & vbNewLine _
& "Hello," & vbNewLine & "A browse dialog will now open." & vbNewLine &
vbNewLine _
& " 1. Please select the FIVE Order Status files at once,
using SHIFT or CTRL, and click OK." & vbNewLine & vbNewLine _
& " 2. Remember, always IGNORE the international file named
""IN..." & vbNewLine & vbNewLine & vbNewLine
On Error GoTo ErrorHandler

Dim SaveDriveDir As String
Dim MyPath As String 'Dim FilesInPath As String
Dim MyFiles() As Variant
Dim SourceRcount1, SourceRcount2 As Long
Dim Fnum As Long
Dim basebook, mybook As Workbook
Dim sourceRange1, sourceRange2 As Range
Dim destrange1, destrange2 As Range
Dim rnum1, rnum2 As Long
Dim lrow1, lrow2 As Long
Dim lcol1, lcol2 As Long

SaveDriveDir = CurDir

'Fill in the path\folder where the files are
'on your machine : MyPath = "C:\Data" or on a network :
ChDirNet "\\Server1\StatusFolder\Order_Status"


MyFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", MultiSelect:=True)

MsgBox "Hello," & vbNewLine & vbNewLine _
& "This program will now copy data from all five files to the new Blend
file. "

If IsArray(MyFiles) Then
Application.ScreenUpdating = False

Set basebook = ActiveWorkbook
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
rnum1 = 1
rnum2 = 1

On Error GoTo ErrorHandler 'CleanUp

'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)

Set mybook = Workbooks.Open(MyFiles(Fnum))

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False





These next four lines are my unsuccessful attempt to take pagebreaks off
sheet 2
Set ActiveSheet = ActiveWorkbook.Sheets(2)
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
Set ActiveSheet = mybook.Worksheets(1)






lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName
'mybook.Worksheets(2).Range(mybook.Worksheets(2).C ells(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

Set sourceRange1 =
mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, 1),
mybook.Worksheets(1).Cells(lrow1, lcol1))
''Set sourceRange1 = mybook.Worksheets(1).Range(Cells(1, 1),
Cells(lrow1, lcol1))
'Set sourceRange1 = mybook.Worksheets(1).Range("A1:AA" & lrow1)
Set sourceRange2 =
mybook.Worksheets(2).Range(mybook.Worksheets(2).Ce lls(1, 1),
mybook.Worksheets(2).Cells(lrow2, lcol2))
''Set sourceRange2 = mybook.Worksheets(2).Range(Cells(1, 1),
Cells(lrow2, lcol2))
'Set sourceRange2 = mybook.Worksheets(2).Range("A1:AA" & lrow2)
SourceRcount1 = sourceRange1.Rows.Count
SourceRcount2 = sourceRange2.Rows.Count
Set destrange1 = basebook.Worksheets(1).Range("A" & rnum1)
Set destrange2 = basebook.Worksheets(2).Range("A" & rnum2)

sourceRange1.Copy destrange1
sourceRange2.Copy destrange2
' Instead of this line you can use the code below to copy only
the values

' With sourceRange
' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
'
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

rnum1 = rnum1 + SourceRcount1
rnum2 = rnum2 + SourceRcount2

'Dim ExcelFileNameRange As Range
'Dim ExcelFileName As String

'ExcelFileName = mybook.Name
'With basebook
' ExcelFileNameRange = basebook.Cells(rnum1, "W")
'End With
' ExcelFileNameRange.Text = ExcelFileName


mybook.Close savechanges:=False
Next Fnum
Else: Exit Sub
Exit Sub
End If

CleanUp:
Application.ScreenUpdating = True
ChDirNet SaveDriveDir

ErrorHandlerNext:
Exit Sub

ErrorHandler:
Err.Raise 1001
'MsgBox "Error " & Err.Number & "; " & Err.Description
'Resume ErrorHandlerNext

End Sub

Get rid of all displaypagebreaks in whole workbook
 

Oh, and I also have to rem out

'mybook.Worksheets(2).Range(mybook.Worksheets(2).C ells(1, "AA"),
_ mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

If I don't rem out all of these I get the error. The pagebreaks on sheet 2
never go away.

"Joel" wrote:

Which line of code

"justme" wrote:

Hi Joel,

It is error 438; Object does not support this property or method. Can you
tell me what to do next?

Thanks!


"Joel" wrote:

The ON ERROR statement is causing the macro to stop. Lets not guess at what
is causing the error. Simply comment out the ON ERROR statement and run the
macro. The code will stop on the error and then you can find the source of
the problem.

"justme" wrote:

I have a sub (with the help of y'all) that lets the user choose multiple
excel files to open, then it loops through each file and copies sheets 1 and
2 from it to a base workbook.

The one thing I am having problems with is I am getting an error that stops
the sub in its tracks. I THINK it is happening because sheet 2 of each
workbook that it copies from is displaying pagebreaks. Does this sound
correct?

I have it set to turn pagebreaks off on the activesheet (sheet 1) when it
opens the file, but I can not get it to turn pagebreaks off on the 2nd sheet.
Can you please help?

Thanks!



Sub m02_GetData()
' This Sub uses 4 functions:
' 1. Private Declare Function SetCurrentDirectoryA (at top of module)
' 2. Public Sub ChDirNet(szPath As String)
' 3. Function LastRow(sh As Worksheet)
' 4. Function LastCol(sh As Worksheet)
' Opens each Order Status Spreadsheet in succession and copies to blank
template
'
'
MsgBox " SELECT ALL FILES AT ONCE" & vbNewLine &
vbNewLine & vbNewLine _
& "Hello," & vbNewLine & "A browse dialog will now open." & vbNewLine &
vbNewLine _
& " 1. Please select the FIVE Order Status files at once,
using SHIFT or CTRL, and click OK." & vbNewLine & vbNewLine _
& " 2. Remember, always IGNORE the international file named
""IN..." & vbNewLine & vbNewLine & vbNewLine
On Error GoTo ErrorHandler

Dim SaveDriveDir As String
Dim MyPath As String 'Dim FilesInPath As String
Dim MyFiles() As Variant
Dim SourceRcount1, SourceRcount2 As Long
Dim Fnum As Long
Dim basebook, mybook As Workbook
Dim sourceRange1, sourceRange2 As Range
Dim destrange1, destrange2 As Range
Dim rnum1, rnum2 As Long
Dim lrow1, lrow2 As Long
Dim lcol1, lcol2 As Long

SaveDriveDir = CurDir

'Fill in the path\folder where the files are
'on your machine : MyPath = "C:\Data" or on a network :
ChDirNet "\\Server1\StatusFolder\Order_Status"


MyFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", MultiSelect:=True)

MsgBox "Hello," & vbNewLine & vbNewLine _
& "This program will now copy data from all five files to the new Blend
file. "

If IsArray(MyFiles) Then
Application.ScreenUpdating = False

Set basebook = ActiveWorkbook
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
rnum1 = 1
rnum2 = 1

On Error GoTo ErrorHandler 'CleanUp

'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)

Set mybook = Workbooks.Open(MyFiles(Fnum))

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False





These next four lines are my unsuccessful attempt to take pagebreaks off
sheet 2
Set ActiveSheet = ActiveWorkbook.Sheets(2)
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
Set ActiveSheet = mybook.Worksheets(1)






lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName
'mybook.Worksheets(2).Range(mybook.Worksheets(2).C ells(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

Set sourceRange1 =
mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, 1),
mybook.Worksheets(1).Cells(lrow1, lcol1))
''Set sourceRange1 = mybook.Worksheets(1).Range(Cells(1, 1),
Cells(lrow1, lcol1))
'Set sourceRange1 = mybook.Worksheets(1).Range("A1:AA" & lrow1)
Set sourceRange2 =
mybook.Worksheets(2).Range(mybook.Worksheets(2).Ce lls(1, 1),
mybook.Worksheets(2).Cells(lrow2, lcol2))
''Set sourceRange2 = mybook.Worksheets(2).Range(Cells(1, 1),
Cells(lrow2, lcol2))
'Set sourceRange2 = mybook.Worksheets(2).Range("A1:AA" & lrow2)
SourceRcount1 = sourceRange1.Rows.Count
SourceRcount2 = sourceRange2.Rows.Count
Set destrange1 = basebook.Worksheets(1).Range("A" & rnum1)
Set destrange2 = basebook.Worksheets(2).Range("A" & rnum2)

sourceRange1.Copy destrange1
sourceRange2.Copy destrange2
' Instead of this line you can use the code below to copy only
the values

' With sourceRange
' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
'
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

rnum1 = rnum1 + SourceRcount1
rnum2 = rnum2 + SourceRcount2

'Dim ExcelFileNameRange As Range
'Dim ExcelFileName As String

'ExcelFileName = mybook.Name
'With basebook
' ExcelFileNameRange = basebook.Cells(rnum1, "W")
'End With
' ExcelFileNameRange.Text = ExcelFileName


mybook.Close savechanges:=False
Next Fnum
Else: Exit Sub
Exit Sub
End If

CleanUp:
Application.ScreenUpdating = True
ChDirNet SaveDriveDir

ErrorHandlerNext:
Exit Sub

ErrorHandler:
Err.Raise 1001
'MsgBox "Error " & Err.Number & "; " & Err.Description
'Resume ErrorHandlerNext

End Sub

Get rid of all displaypagebreaks in whole workbook
 

This is the code I got working

You can't set the variable Activesheet, it is read only
ActiveWorkbook.Sheets(2).Activate
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
mybook.Worksheets(1).Activate

lrow1 = 5


Error in this statement you had the range on worksheet 1 & 2
mybook.Worksheets(2).Range(mybook.Worksheets(2). _
Cells(1, "AA"), mybook.Worksheets(2). _
Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

"justme" wrote:

Oh, and I also have to rem out

'mybook.Worksheets(2).Range(mybook.Worksheets(2).C ells(1, "AA"),
_ mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

If I don't rem out all of these I get the error. The pagebreaks on sheet 2
never go away.

"Joel" wrote:

Which line of code

"justme" wrote:

Hi Joel,

It is error 438; Object does not support this property or method. Can you
tell me what to do next?

Thanks!


"Joel" wrote:

The ON ERROR statement is causing the macro to stop. Lets not guess at what
is causing the error. Simply comment out the ON ERROR statement and run the
macro. The code will stop on the error and then you can find the source of
the problem.

"justme" wrote:

I have a sub (with the help of y'all) that lets the user choose multiple
excel files to open, then it loops through each file and copies sheets 1 and
2 from it to a base workbook.

The one thing I am having problems with is I am getting an error that stops
the sub in its tracks. I THINK it is happening because sheet 2 of each
workbook that it copies from is displaying pagebreaks. Does this sound
correct?

I have it set to turn pagebreaks off on the activesheet (sheet 1) when it
opens the file, but I can not get it to turn pagebreaks off on the 2nd sheet.
Can you please help?

Thanks!



Sub m02_GetData()
' This Sub uses 4 functions:
' 1. Private Declare Function SetCurrentDirectoryA (at top of module)
' 2. Public Sub ChDirNet(szPath As String)
' 3. Function LastRow(sh As Worksheet)
' 4. Function LastCol(sh As Worksheet)
' Opens each Order Status Spreadsheet in succession and copies to blank
template
'
'
MsgBox " SELECT ALL FILES AT ONCE" & vbNewLine &
vbNewLine & vbNewLine _
& "Hello," & vbNewLine & "A browse dialog will now open." & vbNewLine &
vbNewLine _
& " 1. Please select the FIVE Order Status files at once,
using SHIFT or CTRL, and click OK." & vbNewLine & vbNewLine _
& " 2. Remember, always IGNORE the international file named
""IN..." & vbNewLine & vbNewLine & vbNewLine
On Error GoTo ErrorHandler

Dim SaveDriveDir As String
Dim MyPath As String 'Dim FilesInPath As String
Dim MyFiles() As Variant
Dim SourceRcount1, SourceRcount2 As Long
Dim Fnum As Long
Dim basebook, mybook As Workbook
Dim sourceRange1, sourceRange2 As Range
Dim destrange1, destrange2 As Range
Dim rnum1, rnum2 As Long
Dim lrow1, lrow2 As Long
Dim lcol1, lcol2 As Long

SaveDriveDir = CurDir

'Fill in the path\folder where the files are
'on your machine : MyPath = "C:\Data" or on a network :
ChDirNet "\\Server1\StatusFolder\Order_Status"


MyFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", MultiSelect:=True)

MsgBox "Hello," & vbNewLine & vbNewLine _
& "This program will now copy data from all five files to the new Blend
file. "

If IsArray(MyFiles) Then
Application.ScreenUpdating = False

Set basebook = ActiveWorkbook
'clear all cells on the first sheet
'basebook.Worksheets(1).Cells.Clear
rnum1 = 1
rnum2 = 1

On Error GoTo ErrorHandler 'CleanUp

'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)

Set mybook = Workbooks.Open(MyFiles(Fnum))

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False





These next four lines are my unsuccessful attempt to take pagebreaks off
sheet 2
Set ActiveSheet = ActiveWorkbook.Sheets(2)
ActiveWindow.View = xlNormalView
ActiveSheet.DisplayPageBreaks = False
Set ActiveSheet = mybook.Worksheets(1)






lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName
'mybook.Worksheets(2).Range(mybook.Worksheets(2).C ells(1, "AA"),
mybook.Worksheets(1).Cells(lrow1, "AA")).Value = ActiveWorkbook.FullName

lrow1 = Lastrow(mybook.Sheets(1))
lrow2 = Lastrow(mybook.Sheets(2))
lcol1 = LastCol(mybook.Sheets(1))
lcol2 = LastCol(mybook.Sheets(2))

Set sourceRange1 =
mybook.Worksheets(1).Range(mybook.Worksheets(1).Ce lls(1, 1),
mybook.Worksheets(1).Cells(lrow1, lcol1))
''Set sourceRange1 = mybook.Worksheets(1).Range(Cells(1, 1),
Cells(lrow1, lcol1))
'Set sourceRange1 = mybook.Worksheets(1).Range("A1:AA" & lrow1)
Set sourceRange2 =
mybook.Worksheets(2).Range(mybook.Worksheets(2).Ce lls(1, 1),
mybook.Worksheets(2).Cells(lrow2, lcol2))
''Set sourceRange2 = mybook.Worksheets(2).Range(Cells(1, 1),
Cells(lrow2, lcol2))
'Set sourceRange2 = mybook.Worksheets(2).Range("A1:AA" & lrow2)
SourceRcount1 = sourceRange1.Rows.Count
SourceRcount2 = sourceRange2.Rows.Count
Set destrange1 = basebook.Worksheets(1).Range("A" & rnum1)
Set destrange2 = basebook.Worksheets(2).Range("A" & rnum2)

sourceRange1.Copy destrange1
sourceRange2.Copy destrange2
' Instead of this line you can use the code below to copy only
the values

' With sourceRange
' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
'
Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

rnum1 = rnum1 + SourceRcount1
rnum2 = rnum2 + SourceRcount2

'Dim ExcelFileNameRange As Range
'Dim ExcelFileName As String

'ExcelFileName = mybook.Name
'With basebook
' ExcelFileNameRange = basebook.Cells(rnum1, "W")
'End With
' ExcelFileNameRange.Text = ExcelFileName


mybook.Close savechanges:=False
Next Fnum
Else: Exit Sub
Exit Sub
End If

CleanUp:
Application.ScreenUpdating = True
ChDirNet SaveDriveDir

ErrorHandlerNext:
Exit Sub

ErrorHandler:
Err.Raise 1001
'MsgBox "Error " & Err.Number & "; " & Err.Description
'Resume ErrorHandlerNext

End Sub

Get rid of all displaypagebreaks in whole workbook
 

Hey, you are a genius! Thank you, all is working well now....just wonderful!

:)