CODEWITHSUNDEEP
excelvba
NvyFie
NvyFie

Reputation: 11

Excel Macro Automating Cells and Columns editing

Hi I am trying to automate insertion of columns and moving of data within a certain part of a spreadsheet. Currently What the Macro is

Sub Macro1()
'
' Macro1 Macro
'

'
    Rows("6:9").Select
    Selection.Insert Shift:=xlDown
    Range("F5").Select
    Selection.Cut
    Range("E6").Select
    ActiveSheet.Paste
    Range("G5").Select
    Selection.Cut
    Range("E7").Select
    ActiveSheet.Paste
    Range("H5").Select
    Selection.Cut
    Range("E8").Select
    ActiveSheet.Paste
    Range("I5").Select
    Selection.Cut
    Range("E9").Select
    ActiveSheet.Paste
    Range("A5").Select
    Selection.Copy
    Range("D6:D9").Select
    ActiveSheet.Paste
    Range("C6").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "10000"
    Range("C7").Select
    ActiveCell.FormulaR1C1 = "20000"
    Range("C8").Select
    ActiveCell.FormulaR1C1 = "30000"
    Range("C9").Select
    ActiveCell.FormulaR1C1 = "40000"
    Range("C10").Select
End Sub

How do i change it so that it will update dynamically when i select a new set of rows again ?

Upvotes: 0

Views: 81

Answers (2)

Naresh
Naresh

Reputation: 3034

With the following edited macro you can select any number of rows to be inserted and with inputbox

Option Explicit
Sub Macro1()
Dim newRows As Range, newRowsAddress As String, previousRow As Range
Dim ColumnLetter As String, i As Long, j As Long

On Error Resume Next
Set newRows = Application.InputBox("Select rows to insert", "New Rows", , , , , , 8)
If newRows Is Nothing Then Exit Sub
On Error GoTo 0
Set previousRow = newRows.Offset(-1).Resize(1, Columns.Count)
newRowsAddress = newRows.Address

'    Rows("6:9").Select
'    Selection.Insert Shift:=xlDown
'    Range("F5").Select
'    Selection.Cut
'    Range("E6").Select
'    ActiveSheet.Paste
'    Range("G5").Select
'    Selection.Cut
'    Range("E7").Select
'    ActiveSheet.Paste
'    Range("H5").Select
'    Selection.Cut
'    Range("E8").Select
'    ActiveSheet.Paste
'    Range("I5").Select
'    Selection.Cut
'    Range("E9").Select
'    ActiveSheet.Paste
newRows.Insert Shift:=xlDown
Set newRows = Range(newRowsAddress)
ColumnLetter = Split(Cells(1, 5 + newRows.Rows.Count).Address, "$")(1)
newRows.Columns("E:E").Value = Application.Transpose(previousRow.Columns("F:" & ColumnLetter).Value)

'    Range("A5").Select
'    Selection.Copy
'    Range("D6:D9").Select
'    ActiveSheet.Paste

newRows.Columns("D:D").Value = Application.Transpose(previousRow.Columns("A:A").Value)

'    Range("C6").Select
'    Application.CutCopyMode = False
'    ActiveCell.FormulaR1C1 = "10000"
'    Range("C7").Select
'    ActiveCell.FormulaR1C1 = "20000"
'    Range("C8").Select
'    ActiveCell.FormulaR1C1 = "30000"
'    Range("C9").Select
'    ActiveCell.FormulaR1C1 = "40000"
'    Range("C10").Select
j = 1
For i = newRows.Rows(1).Row To newRows.Rows(newRows.Rows.Count).Row
Range("C" & i) = j * 10000
j = j + 1
Next i
End Sub

Two New Rows Two New Rows or Seven New Rows Seven New Rows

Upvotes: 2

DYMATEJlb
DYMATEJlb

Reputation: 97

Try using the "Use Relative References" option when recording your macro.

Upvotes: 1

Related Questions