Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Exceeding 65K of defined names within workbook causes workbook to go into repair mode when it is opened | Excel Programming | |||
loop through a column on a workbook copying data on each row to another workbook, then copy data back to the original workbook | Excel Programming | |||
Select sheet tabs in workbook & save to separate workbook files | Excel Worksheet Functions | |||
Running a macro to protect a workbook on a already protected workbook UNprotects the workbook ?? | Excel Programming | |||
What commands do you use to name a workbook, save a workbook,open a workbook | Excel Programming |