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

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/

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

Expand column to copy
 

Tom,

All is resolved.

Thank you!!!

--
Message posted from http://www.ExcelForum.com