Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Expand column to copy
Hi all,
Couls someone please advise me hot to amend this code so as to cop column B and C to column B and C on sheet1. It currently only copie and pastes one column. Cheers all!!!!! Private Sub CommandButton1_Click() CopyData Range("C10:C18"), "BASE MACHINE" CopyData Range("C34:C103"), "CONTROL INCLUSIONS - UNIT 1" CopyData Range("C108:C117"), "FEEDER INCLUSIONS - UNIT 1" CopyData Range("C122:C179"), "FOLDING UNIT INCLUSIONS - UNIT 1" CopyData Range("C191:C227"), "CONTROL INCLUSIONS - UNIT 2, 78cm" CopyData Range("C232:C286"), "FOLDING UNIT INCLUSIONS - UNIT 2, 78cm" CopyData Range("C298:C331"), "CONTROL INCLUSIONS - UNIT 2, 68cm" CopyData Range("C336:C390"), "FOLDING UNIT INCLUSIONS - UNIT 2, 68cm" CopyData Range("C471:C486"), "CONTROL INCLUSIONS - UNIT 3, 56cm" CopyData Range("C425:C470"), "FOLDING UNIT INCLUSIONS - UNIT 3, 56cm" 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("sheet1") Set rng = Sh.Columns(1).Find(What:=Target, _ After:=Sh.Range("A1"), _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If rng Is Nothing Then MsgBox Target & " Not found" Exit Sub End If Set rng3 = rng Worksheets("sheet1").Unprotect Password:="jenjen1" rng.Offset(1, 0).ClearContents If Application.CountA(rng3) 2 Then Else Set rng3 = rng.Offset(2, 0) End If rw = rng3.Row rng3.Resize(nrow * 2, 1).EntireRow.Insert For Each cell In rngC If Not IsEmpty(cell) Then If IsNumeric(cell) Then If cell 0 Then Cells(cell.Row, 1).Resize(1, 2).Copy _ Destination:=Sh.Cells(rw, 1) rw = rw + 2 End If End If End If Next Worksheets("sheet1").Protect Password:="jenjen1" End Su -- Message posted from http://www.ExcelForum.com |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Expand column to copy
Cells(cell.Row, 1).Resize(1, 2).Copy _
Destination:=Sh.Cells(rw, 1) clearly copies A and B to A and B so I am not sure why you say it copies only one column. If you want B and C Cells(cell.Row, 2).Resize(1, 2).Copy _ Destination:=Sh.Cells(rw, 2) -- Regards, Tom Ogilvy "gavmer " wrote in message ... Hi all, Couls someone please advise me hot to amend this code so as to copy column B and C to column B and C on sheet1. It currently only copies and pastes one column. Cheers all!!!!! Private Sub CommandButton1_Click() CopyData Range("C10:C18"), "BASE MACHINE" CopyData Range("C34:C103"), "CONTROL INCLUSIONS - UNIT 1" CopyData Range("C108:C117"), "FEEDER INCLUSIONS - UNIT 1" CopyData Range("C122:C179"), "FOLDING UNIT INCLUSIONS - UNIT 1" CopyData Range("C191:C227"), "CONTROL INCLUSIONS - UNIT 2, 78cm" CopyData Range("C232:C286"), "FOLDING UNIT INCLUSIONS - UNIT 2, 78cm" CopyData Range("C298:C331"), "CONTROL INCLUSIONS - UNIT 2, 68cm" CopyData Range("C336:C390"), "FOLDING UNIT INCLUSIONS - UNIT 2, 68cm" CopyData Range("C471:C486"), "CONTROL INCLUSIONS - UNIT 3, 56cm" CopyData Range("C425:C470"), "FOLDING UNIT INCLUSIONS - UNIT 3, 56cm" 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("sheet1") Set rng = Sh.Columns(1).Find(What:=Target, _ After:=Sh.Range("A1"), _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If rng Is Nothing Then MsgBox Target & " Not found" Exit Sub End If Set rng3 = rng Worksheets("sheet1").Unprotect Password:="jenjen1" rng.Offset(1, 0).ClearContents If Application.CountA(rng3) 2 Then Else Set rng3 = rng.Offset(2, 0) End If rw = rng3.Row rng3.Resize(nrow * 2, 1).EntireRow.Insert For Each cell In rngC If Not IsEmpty(cell) Then If IsNumeric(cell) Then If cell 0 Then Cells(cell.Row, 1).Resize(1, 2).Copy _ Destination:=Sh.Cells(rw, 1) rw = rw + 2 End If End If End If Next Worksheets("sheet1").Protect Password:="jenjen1" End Sub --- Message posted from http://www.ExcelForum.com/ |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Expand column to copy
Tom,
I apologise for the confusion. Could you advise how to copy the cel values rather than the formulas? Cheers! -- Message posted from http://www.ExcelForum.com |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Expand column to copy
|
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to copy a cell and horizontally expand the paste along header | Excel Discussion (Misc queries) | |||
Can I expand a cell without expanding the whole column in Excel? | Excel Worksheet Functions | |||
How do I expand my excel worksheet past column IV | Setting up and Configuration of Excel | |||
Expand only one cell in a column | Excel Discussion (Misc queries) | |||
how do I expand a cell without expanding column | Excel Worksheet Functions |