Link to home
Start Free TrialLog in
Avatar of james
jamesFlag for United Kingdom of Great Britain and Northern Ireland

asked on

Need more rows added to a macro and also draw lines to create boxes

I have the following macro that im trying to add to.


What I currently have it does what I want it to but want to add to it now.


Macro is currently this..

Option Explicit


Sub TransferData()
Dim lngLastRow As Long
Dim lngRow As Long
Dim strSheetName As String
Dim wsSource As Worksheet


lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set wsSource = ActiveSheet


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


strSheetName = InputBox("Please enter the name of the new worksheet", "Transfer Data")
If StrPtr(strSheetName) = 0 Then
    MsgBox "No worksheet name entered"
    Exit Sub
End If


Sheets.Add(After:=Sheets(Sheets.Count)).Name = strSheetName
wsSource.Range("A1:Z" & lngLastRow).Copy
With ActiveSheet
    .Range("A1").PasteSpecial
    .Range("G10:Z" & lngLastRow).Clear
    For lngRow = lngLastRow To 1 Step -1
        If Not IsEmpty(.Cells(lngRow, "Y")) Then
            If .Cells(lngRow, "Y") = 0 Then
                .Cells(lngRow, "Y").EntireRow.Delete
            End If
        End If
    Next
End With


With Application
    .Calculation = xlCa

Open in new window


I need this added with other stuff too.

 Cells.Select
    Cells.EntireColumn.AutoFit
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    Range("Y10").Select
    ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, _
        DisplayAsIcon:=False, NoHTMLFormatting:=True
    Range("Y10").Select

Open in new window

What I also want to do is insert 150 new lines below the last entry in column A and make the cells look like a box.  What I mean is select from cell A10 -Y??? and then draw lines in.


Also the formula thats in cell Y10 I need copying all the way down the workbook all the time there is data in column A.



Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Your line 45 (.Calculation = xlCa) is cut off.
ASKER CERTIFIED SOLUTION
Avatar of james
james
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I’m glad I was able to help.

If you expand the “Full Biography" section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
        Experts Exchange Most Valuable Expert (MVE) 2015 and 2017
        Experts Exchange Distinguished Expert in Excel 2018, 2021, 2022
        Experts Exchange Distinguished Expert in Microsoft Office 2022
        Experts Exchange Distinguished Expert in VBA 2022
        Experts Exchange Top Expert VBA 2018 to 2022
        Experts Exchange Top Expert Visual Basic Classic 2012 to 2022