![]() |
VBA code needing alteration
I am a novice with VBA and require alteration to this code, if possible
What i have now is the first 3 rows copying across. What i would lik is to have selected cells in the row copy. ie: a1, a2 and a4. Is thi possible?? Thank you Private Sub Commandbutton1_click() CopyData Range("E90:E100"), "MODEL" CopyData Range("E105:E113"), "UV CURING" CopyData Range("E118:E134"), "TRANSFORMER" End Sub Private Sub CopyData(rngC As Range, Target As String) Dim rng As Range, cell As Range Dim rng1 As Range, rng2 As Range Dim rng3 As Range Dim nrow As Long, rw As Long Dim sh As Worksheet nrow = Application.CountIf(rngC, "0") If nrow = 0 Then Exit Sub Set sh = Worksheets("Quote2") Set rng = sh.Columns(1).Find(What:=Target, _ After:=sh.Range("A1"), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) ' Set rng1 = sh.Columns(1).FindNext(rng) ' Set rng3 = sh.Range(rng, rng1) Set rng3 = rng rng.Offset(1, 0).ClearContents If Application.CountA(rng3) 2 Then ' Set rng3 = rng1.End(xlUp).Offset(2, 0) Else Set rng3 = rng.Offset(2, 0) End If rw = rng3.Row rng3.Resize(nrow * 2, 1).EntireRow.Insert For Each cell In rngE If Not IsEmpty(cell) Then If IsNumeric(cell) Then If cell 0 Then Cells(cell.Row, 1).Resize(1, 3).Copy _ Destination:=sh.Cells(rw, 1) rw = rw + 2 End If End If End If Next End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) End Su -- Message posted from http://www.ExcelForum.com |
All times are GMT +1. The time now is 08:46 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com