Auto Fill VBA Code

F

fwurster

New Member
Joined
Sep 15, 2014
Messages
2
Hi, I have a code that loops through any # of worksheets and consolidates them. Once consolidated, it inserts the formula I coded. The only piece I can not get to work is the Autofill piece. Where do I define "LastRow" to get this to work? It is towards the end of the code, so you can skip most of it to see what I am referring to.

Thanks!!!

Code: 
Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Delete the sheet "Consolidation" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Consolidation").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True


    'Add a worksheet with the name "Consolidation"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Consolidation"
    
    'Copies header from AuditSurveyPM tab to the consolidation sheet
    Sheets("Header").Rows("1:1").Copy Sheets("Consolidation").Range("A2")
    
    
    'loop through all worksheets and copy the data to the DestSh


    
    For Each sh In ActiveWorkbook.Worksheets
        sh.Activate
        If IsError(Application.Match(sh.Name, _
            Array(DestSh.Name, "RUN REPORT"), 0)) Then
 
        'Loop through all worksheets except the Consolidation worksheet and the
        'more sheets can be added to the array if you want.
        If IsError(Application.Match(sh.Name, Array(DestSh.Name, "Consolidation"), 0)) Then
                                            
            'Find the last row with data on the DestSh
            Last = LastRow(DestSh)
    
            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("A3:Y2000")


            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If


            'This example copies values/formats
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "C")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


        End If
        End If
    Next sh
        




ExitTheSub:


' SortConsol Macro
    Range("A3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range("A3:Y20000").Select
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "F3:F19997"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "H3:H19997"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "D3:D19997"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "E3:E19997"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "C3:C19997"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Consolidation").Sort
        .SetRange Range("A3:Y19997")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    Application.Goto DestSh.Cells(1)


    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With


'Set Font style and size
Range("A3:Y2000").Font.Name = "Arial"
Range("A3:Y2000").Font.Size = "11"


'Set column width
Columns("A").ColumnWidth = 7.11
Columns("B").ColumnWidth = 9.56
Columns("C").ColumnWidth = 7.11
Columns("D").ColumnWidth = 9.56
Columns("E").ColumnWidth = 12.78
Columns("F").ColumnWidth = 13.89
Columns("G").ColumnWidth = 10.22
Columns("H").ColumnWidth = 8.44
Columns("I").ColumnWidth = 15.44
Columns("J").ColumnWidth = 9.11
Columns("K").ColumnWidth = 10.22
Columns("L").ColumnWidth = 33.33
Columns("M").ColumnWidth = 12
Columns("N").ColumnWidth = 6.89
Columns("O").ColumnWidth = 11.89
Columns("P").ColumnWidth = 51.11
Columns("Q").ColumnWidth = 26
Columns("R").ColumnWidth = 34
Columns("S").ColumnWidth = 10.89
Columns("T").ColumnWidth = 20.11
Columns("U").ColumnWidth = 5.78
Columns("V").ColumnWidth = 11
Columns("W").ColumnWidth = 7.44
Columns("X").ColumnWidth = 7.44
Columns("Y").ColumnWidth = 11
Columns("Z").ColumnWidth = 6.01
Columns("AA").ColumnWidth = 10


'AutoFit Rows
Rows("2:3000").Select
Rows("2:3000").EntireRow.AutoFit
Rows("2:3000").EntireRow.AutoFit
Range("A1").Select


'Freeze Panes
Range("C3").Select
ActiveWindow.FreezePanes = True


'Insert Formulas in col A & B


    Dim strformulas(1 To 2) As Variant
        
    With ThisWorkbook.Sheets("Consolidation")
        strformulas(1) = "=J3-B3"
        strformulas(2) = "=IF(C3=""Pass"",J3,F3)"
        
        LastRow = Range("C25000").End(xlUp).Row
        .Range("A3:B3").Formula = strformulas
        .Range("A3:B3").AutoFill Destination:=Range("A3:B" & LastRow), Type:=xlFillDefault
        
    End With


'Move Consolidation tab after RUN REPORT tab
    Sheets("Consolidation").Select
    Sheets("Consolidation").Move After:=Sheets("RUN REPORT")


End Sub
 
Last edited by a moderator:

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Sort by date Sort by votes
Got It!

Code: 
Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Delete the sheet "Consolidation" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Consolidation").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True


    'Add a worksheet with the name "Consolidation"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Consolidation"
    
    'Copies header from AuditSurveyPM tab to the consolidation sheet
    Sheets("Header").Rows("1:1").Copy Sheets("Consolidation").Range("A2")
    
    
    'loop through all worksheets and copy the data to the DestSh


    
    For Each sh In ActiveWorkbook.Worksheets
        sh.Activate
        If IsError(Application.Match(sh.Name, _
            Array(DestSh.Name, "RUN REPORT"), 0)) Then
 
        'Loop through all worksheets except the Consolidation worksheet and the
        'more sheets can be added to the array if you want.
        If IsError(Application.Match(sh.Name, Array(DestSh.Name, "Consolidation"), 0)) Then
                                            
            'Find the last row with data on the DestSh
            Last = lastRow(DestSh)
    
            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("A3:Y2000")


            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If


            'This example copies values/formats
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "C")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


        End If
        End If
    Next sh
        




ExitTheSub:


' SortConsol Macro
    Range("A3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range("A3:Y20000").Select
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "F3:F19997"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "H3:H19997"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "D3:D19997"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "E3:E19997"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "C3:C19997"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Consolidation").Sort
        .SetRange Range("A3:Y19997")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    Application.Goto DestSh.Cells(1)


    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With


'Set Font style and size
Range("A3:Y2000").Font.Name = "Arial"
Range("A3:Y2000").Font.Size = "11"


'Set column width
Columns("A").ColumnWidth = 7.11
Columns("B").ColumnWidth = 9.56
Columns("C").ColumnWidth = 7.11
Columns("D").ColumnWidth = 9.56
Columns("E").ColumnWidth = 12.78
Columns("F").ColumnWidth = 13.89
Columns("G").ColumnWidth = 10.22
Columns("H").ColumnWidth = 8.44
Columns("I").ColumnWidth = 15.44
Columns("J").ColumnWidth = 9.11
Columns("K").ColumnWidth = 10.22
Columns("L").ColumnWidth = 33.33
Columns("M").ColumnWidth = 12
Columns("N").ColumnWidth = 6.89
Columns("O").ColumnWidth = 11.89
Columns("P").ColumnWidth = 51.11
Columns("Q").ColumnWidth = 26
Columns("R").ColumnWidth = 34
Columns("S").ColumnWidth = 10.89
Columns("T").ColumnWidth = 20.11
Columns("U").ColumnWidth = 5.78
Columns("V").ColumnWidth = 11
Columns("W").ColumnWidth = 7.44
Columns("X").ColumnWidth = 7.44
Columns("Y").ColumnWidth = 11
Columns("Z").ColumnWidth = 6.01
Columns("AA").ColumnWidth = 10


'AutoFit Rows
Rows("2:3000").Select
Rows("2:3000").EntireRow.AutoFit
Rows("2:3000").EntireRow.AutoFit
Range("A1").Select


'Freeze Panes
Range("C3").Select
ActiveWindow.FreezePanes = True


'Insert Formulas in col A & B


    Dim strformulas(1 To 2) As Variant
    Dim lastRow2 As Long
    
    With ThisWorkbook.Sheets("Consolidation")
        strformulas(1) = "=J3-B3"
        strformulas(2) = "=IF(C3=""Pass"",J3,F3)"
        
        .Range("A3:B3").Formula = strformulas
        lastRow2 = Range("C" & Rows.Count).End(xlUp).Row
        Range("A3:B3").AutoFill Destination:=Range("A3:B" & lastRow2)
        
    End With


'Move Consolidation tab after RUN REPORT tab
    Sheets("Consolidation").Select
    Sheets("Consolidation").Move After:=Sheets("RUN REPORT")


End Sub

EDIT: added Code tags - Please use 'em. [ code ] Your Code [ / Code ] (no spaces) - Moderator
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Solved
VBA: Deleting Visible rows using Auto Filter; Excluding Header
Replies
4
Views
438
mumps
mumps
Dazzawm
  • Question
Change Recorded Range To Used Range.
2
Replies
12
Views
398
Dazzawm
Dazzawm
Z
  • Solved
VBA Code to Hide columns in Specific Intervals
2
Replies
11
Views
409
jolivanes
jolivanes
G
  • Solved
Still no solution after 1 Year - Please Help
2
Replies
10
Views
398
jolivanes
jolivanes
Dazzawm
  • Solved
Slight Amendment To Code
Replies
6
Views
306
Dazzawm
Dazzawm

Forum statistics

Threads
1,215,575
Messages
6,125,620
Members
449,240
Latest member
lynnfromHGT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top