We help IT Professionals succeed at work.
Get Started

Excel Line Limit

dn920
dn920 asked
on
273 Views
Last Modified: 2012-05-12
I am using the following code to pull in several work books and copy a page out of them. I am using the new version of excel so we can go beyond the 65536 limit, however when we started we were limited by the old excel.

Is it possible to modify this code to go to the bottom no matter what line? I have tried to change the code to a larger number but it debugs each time.


Option Explicit
 
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim Lastrow As Long
Dim Firstrow1 As Long
Dim LastRow1 As Long
Dim Lrow1 As Long
Dim myRange As Range

Sub CompileAllChecksInFolder()
    Application.ScreenUpdating = False
    ChDrive ActiveWorkbook.Path
    ChDir ActiveWorkbook.Path
    ToBook = ActiveWorkbook.Name
    '---------------------------
    '- MASTER SHEET
    '---------------------------
    Set ToSheet = ActiveSheet
    NumColumns = ToSheet.Range("A1").End(xlToRight).Column
    ToRow = ToSheet.Range("A65536").End(xlUp).Row
    If ToRow <> 1 Then
        ToSheet.Range(ToSheet.Cells(2, 1), _
            ToSheet.Cells(ToRow, NumColumns)).ClearContents
    End If
    ToRow = 3
    '------------------------------------------
    '- main loop to open each file in folder
    '------------------------------------------
    FromBook = Dir("*.xls")
    While FromBook <> ""
        If FromBook <> ToBook Then
            Application.StatusBar = FromBook
            Transfer_data   ' subroutine below
        End If
        FromBook = Dir
    Wend

Set myRange = Range("B2", Range("B65536").End(xlUp))
myRange.Select
Application.ScreenUpdating = True
MsgBox ("I am going to clean up the data now, this may take several minutes.......")
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "PO Number"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Invoice Number"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "DC number"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Store Number"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Division"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Microfilm Number"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "Invoice Date"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "Invoice Amount"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "Date Paid"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "Discount"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "Amount Paid"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "Deduction Code"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "Combined Deduction"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "Payment"
    Range("A2:N2").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Underline = False
    End With
    Selection.Font.Bold = True
    Range("A2").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    With Selection.Font
        .Underline = False
        .Name = "Arial"
        .Size = 8
    End With
    Range("A2").Select
    Application.CutCopyMode = False
Application.ScreenUpdating = True

MsgBox ("Step One Is complete, validate information and go on to step 2")



End Sub

Private Sub Transfer_data()
    Workbooks.Open FileName:=FromBook
       'For Each FromSheet In Workbooks(FromBook).Worksheets
           'Sheets("Sheet1").Select
       Set FromSheet = Workbooks(FromBook).Worksheets("Sheet1")
          Lastrow = FromSheet.Range("A65536").End(xlUp).Row
             
        '-----------------------------------------------------
        '- copy/paste to master sheet
        FromSheet.Range(FromSheet.Cells(3, 1), _
        FromSheet.Cells(Lastrow, NumColumns)).Copy _
        Destination:=ToSheet.Range("A" & ToRow)
        '-----------------------------------------------------
        '- set next ToRow
        ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
    'Next
    Workbooks(FromBook).Close SaveChanges:=False
End Sub

Open in new window

Comment
Watch Question
Test your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Distinguished Expert 2020
Commented:
This problem has been solved!
Unlock 1 Answer and 5 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE