Sub test() Dim rng As Range, c As Range Dim rng1 As Range, c1 As Range Dim dest As Range, j As Integer, k As Integer Worksheets("sheet2").Cells.Clear With Worksheets("sheet1") Set rng = Range(.Range("A2"), .Range("A2").End(xlDown)) j = WorksheetFunction.CountA(.Rows("1:1")) 'msgbox j For Each c In rng Set rng1 = Range(c.Offset(0, 1), .Cells(c.Row, Columns.Count).End(xlToLeft)) 'msgbox rng1.Address For Each c1 In rng1 Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0) 'msgbox dest.Address If c1 = "" Then GoTo line1 'dest.Offset(0, 0) = c 'dest.Offset(0, 1) = .Cells(1, c1.Column) 'dest.Offset(0, 2) = c1 dest = c dest.Offset(0, 1) = c1 dest.Offset(0, 2) = .Cells(1, c1.Column) line1: Next c1 Next c End With With Worksheets("sheet2").Columns("c:c") .NumberFormat = "dd-mmm-yy" End With End Sub
Sub test() Dim n As Integer, rng As Range 'n = InputBox("type the value of n") Set rng = Range("a1") rng.Select line2: n = InputBox("type no. of times you want to be repeated minus 1 for e.g if you wnat to be repeated 3 times type 2") Range(rng.Offset(1, 0), rng.Offset(n, 0)).EntireRow.Insert Range(rng, rng.End(xlToRight)).Copy Range(rng, rng.Offset(n, 0)).PasteSpecial Set rng = rng.Offset(n + 1, 0) If rng = "" Then GoTo line1 Else GoTo line2 End If line1: Application.CutCopyMode = False Range("a1").Select MsgBox "macro over" End Sub
Sub test() Dim j As Integer, k As Integer, m As Integer, n As Integer j = Range("a1").End(xlDown).Row 'j is hte lsst row k = j Do If k = 1 Then Exit Do m = Cells(k, "b") - Cells(k, "A") 'MsgBox m 'Range(Cells(k + 1, "A"), Cells(k + m, "A")).Select Range(Cells(k + 1, "A"), Cells(k + m, "A")).EntireRow.Insert For n = 1 To m Cells(k, 1).EntireRow.Copy Cells(k + n, 1) Next n For n = 1 To m Cells(k + n, 1) = Cells(k, 1) + n Next n k = k - 1 'MsgBox k Loop End Sub
Sub undo() Worksheets("sheet1").Cells.Clear Worksheets("sheet2").UsedRange.Copy Worksheets("sheet1").Range("A1")
Sub test() Dim rr As Range, cr As Range, rc As Range, cc As Range, x x = InputBox("type the relevant no. or string e.g. 45") With Worksheets("sheet2") .Cells.Clear End With With Worksheets("sheet1") Set rr = Range(.Range("a2"), .Range("a2").End(xlDown)) For Each cr In rr Set rc = Range(.Cells(cr.Row, 1), .Cells(cr.Row, 1).End(xlToRight)) Set cc = rc.Cells.Find(what:=x, lookat:=xlWhole) If Not cc Is Nothing Then cc.EntireRow.Copy Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial End If Next cr End With Application.CutCopyMode = False End Sub
Sub test() Dim rng As Range, c As Range Dim rng1 As Range, c1 As Range Dim dest As Range, j As Integer, k As Integer Worksheets("sheet2").Cells.Clear With Worksheets("sheet1") Set rng = Range(.Range("A2"), .Range("A2").End(xlDown)) j = WorksheetFunction.CountA(.Rows("1:1")) 'msgbox j For Each c In rng Set rng1 = Range(c.Offset(0, 1), .Cells(c.Row, Columns.Count).End(xlToLeft)) 'msgbox rng1.Address For Each c1 In rng1 Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0) 'msgbox dest.Address If c1 = "" Then GoTo line1 dest.Offset(0, 0) = c dest.Offset(0, 1) = .Cells(1, c1.Column) 'dest.Offset(0, 2) = c1 line1: Next c1 Next c End With End Sub
Sub test() Dim j As Integer, k As Integer Dim m As Integer m = 3 Worksheets("sheet1").Cells.Clear Worksheets("sheet3").Cells.Copy Worksheets("sheet1").Range("A1").PasteSpecial Worksheets("sheet1").Activate j = Range("a1").End(xlDown).Row For k = j To 2 Step -1 Range(Cells(k + 1, 1), Cells(k + m - 1, 1)).EntireRow.Insert Cells(k, 1).EntireRow.Copy Range(Cells(k + 1, 1), Cells(k + m - 1, 1)).PasteSpecial Next k Application.CutCopyMode = False Range("A1").Select End Sub
Sub test() Dim n As Integer, rng As Range n = InputBox("type the value of n") Set rng = Range("a1") rng.Select line2: Range(rng.Offset(1, 0), rng.Offset(3, 0)).EntireRow.Insert Range(rng, rng.End(xlToRight)).Copy Range(rng, rng.Offset(n, 0)).PasteSpecial Set rng = rng.Offset(n + 1, 0) If rng = "" Then GoTo line1 Else GoTo line2 End If line1: Application.CutCopyMode = False Range("a1").Select MsgBox "macro over" End Sub
Start Date End Date Start Time End Time Group Sub Group Details Manager 23-09-09 25-09-09 10:00 AM 11:00 AM Class X section 1 Goes for preparation Teacher 1
Start Date End Date Start Time End Time Group Sub Group Details Manager 23-09-09 25-09-09 10:00 AM 11:00 AM Class X section A preparation Teacher 1 24-09-09 25-09-09 10:00 AM 11:00 AM Class X section A preparation Teacher 1 24-09-09 25-09-09 10:00 AM 11:00 AM Class X section A preparation Teacher 1
ColA ColB ColC A1 text 5 A1 text A1 text A1 text A1 text A1 text
Sub test() Dim x As Integer, r As Range, r1 As Range, c As Range Dim dest As Range Set r = Range(Range("A1"), Range("A1").End(xlDown)) For Each c In r x = Cells(c.Row, "B").Value Set dest = Cells(Rows.Count, "C").End(xlUp).Offset(1, 0) Set r1 = Range(dest, dest.Offset(x - 1, 0)) r1.FormulaArray = c.Value Next c Range(Range("c2"), Range("c2").End(xlDown)).Cut Range("c1") End Sub
Sub test() Dim r As Range, c As Range, j As Long, k As Long, m As Long Worksheets("sheet1").Cells.Clear Worksheets("sheet3").Cells.Copy Worksheets("sheet1").Range("A1") Worksheets("sheet1").Activate Set r = Range(Range("A2"), Range("B2").End(xlDown)) j = Range("A2").End(xlDown).Row 'j is last row For k = j To 2 Step -1 m = Cells(k, "C") 'MsgBox m Range(Cells(k + 1, "A"), Cells(k + m - 1, "A")).EntireRow.Insert Range(Cells(k, "A"), Cells(k, "B")).Copy Range(Cells(k, "D"), Cells(k + m - 1, "d")).PasteSpecial Next k Application.CutCopyMode = False Range("A1").Select End Sub