-1

I am trying to merge two VBA macros into one; I want to run two VBA macros after one click.

Below are the two macros. I have tried separate codes and they are working smoothly but when I try to mix it to one macro it doesn't work.

My Code:

First Macro

    Sub Page_Layout()
    '
    ' Page_Layout Macro
    '

    '
        ActiveWindow.DisplayGridlines = False
        Sheets("Sheet2").Select
        ActiveWindow.DisplayGridlines = False
        Sheets("Sheet1").Select
        ActiveWindow.SmallScroll Down:=96
        Range("A1:I100").Select
        Range("I100").Activate
        With Selection
            .HorizontalAlignment = xlCenter
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.Font.Underline = xlUnderlineStyleSingle
        Selection.Font.Underline = xlUnderlineStyleNone
        ActiveWindow.SmallScroll Down:=-126
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        Selection.Borders(xlEdgeLeft).LineStyle = xlNone
        Selection.Borders(xlEdgeTop).LineStyle = xlNone
        Selection.Borders(xlEdgeBottom).LineStyle = xlNone
        Selection.Borders(xlEdgeRight).LineStyle = xlNone
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        ActiveWindow.SmallScroll Down:=-129
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        ActiveWindow.SmallScroll Down:=-57
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        ActiveWindow.SmallScroll Down:=-129
        Sheets("Sheet2").Select
        Columns("A:F").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection
            .HorizontalAlignment = xlGeneral
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("C1"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet2").Sort
            .SetRange Range("A1:F1")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Columns("A:A").Select
        ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("A1"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet2").Sort
            .SetRange Range("A1")
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Columns("E:E").Select
        Selection.NumberFormat = "#,##0.00"
        ActiveWindow.SmallScroll Down:=66
        Sheets("Sheet1").Select
        ActiveWindow.SmallScroll Down:=-54
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("I100"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SetRange Range("A2:I100")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        ActiveWindow.SmallScroll Down:=-15
        Range("A1:A100").Select
        Range("A100").Activate
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A100"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Sheet1").Sort
            .SetRange Range("A2:A100")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        ActiveWindow.SmallScroll Down:=-57
        Range("B1:B100").Select
        Range("B100").Activate
        Selection.NumberFormat = "0.00"
        Selection.NumberFormat = "0.0"
        Selection.NumberFormat = "0"
        ActiveWindow.SmallScroll Down:=0
        Range("A2:I100").Select
        Range("I100").Activate
        Selection.ClearContents
        ActiveWindow.SmallScroll Down:=-114
        Range("J1").Select
        Columns("J:J").ColumnWidth = 7.29
        Columns("J:J").ColumnWidth = 8.43

        End Sub

Second Macro

Sub copycolumns()
Dim lastrow As Long, erow As Long

lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow

Sheet1.Cells(i, 1).Copy
erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 1)

Sheet1.Cells(i, 3).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 2)

Sheet1.Cells(i, 7).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 3)

Sheet1.Cells(i, 6).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 4)

Sheet1.Cells(i, 5).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 5)

Sheet1.Cells(i, 9).Copy
Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 6)
Next i
Application.CutCopyMode = False
Sheet2.Columns.AutoFit
Range("A1").Select

End Sub

How do I run both macros after one click?

girlvsdata
  • 1,596
  • 11
  • 21
june
  • 17
  • 1
  • 6
  • 1
    Where are they then? Please add them to the question - not in the comments or as answers. – Solar Mike Aug 02 '18 at 05:58
  • cant add code bcz not able to submit – june Aug 02 '18 at 06:02
  • Well, all we can do is guess : how about are the variables equivalent for the two codes? – Solar Mike Aug 02 '18 at 06:05
  • Paste the code into your question through an [edit]. Then select the code and tap ctrl+K. –  Aug 02 '18 at 06:06
  • i am just trying to find help for my question as i am learning – june Aug 02 '18 at 06:14
  • Are some of your formatting sections repeated? – Solar Mike Aug 02 '18 at 06:21
  • Update to followers of this post: it looks like the issue OP was having with posting the code had to do with having too much code and not enough description text, I had the same issue with the question in editing. It was stopping me from submitting without adding more non-code-formatted characters. – girlvsdata Aug 02 '18 at 06:54

2 Answers2

1

There are a lot of issues in your code above and that are probably the cause of your issues with "merging" the two codes. You will probably be able to fix those after gaining some experience working with VBA and reading other questions, comments and answers here on Stack Overflow.

In the meantime, if your above two codes work separately you can get them to run with "one click" by adding one more subroutine that calls the other two:

Sub Page_layout_copy_columns()

Call Page_Layout
Call copycolumns

End Sub

When you paste the above subroutine in your module in the Visual Basic Editor (VBE) and run it, it will run the Page_Layout macro, and then the copycolumns macro.

girlvsdata
  • 1,596
  • 11
  • 21
1

Have you looked at consolidating parts of your code?

From this:

        Range("A1:I100").Select
    Range("I100").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

To this :

        Range("A1:I100").Select
    Range("I100").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

Which may possibly reduce to (but I have not tested):

     With Range("A1:I100")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

Avoiding Select and Activate is apparently good practice, see https://stackoverflow.com/a/20754562/4961700

Solar Mike
  • 7,156
  • 4
  • 17
  • 32
  • Thanks for the share of that link, its got some great information in it. Highly recommend OP to check it out. – girlvsdata Aug 02 '18 at 22:57