ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   additional target (https://www.excelbanter.com/excel-programming/298623-additional-target.html)

gavmer[_11_]

additional target
 
Hello all,

I am re-posting this problem as i havent had any luck so far and am in
urgent need of a fix.

The code below copy/pastes on values in column D. How would i amend so
that column E is included also???? (if E 1)

Cheers in advance!!!!!!!


Private Sub CommandButton3_Click()
CopyData Range("D9:D13"), "FEEDER"
CopyData Range("D16:D58"), "MACHINE"
CopyData Range("D63:D73"), "DELIVERY"
CopyData Range("D78:D82"), "PECOM"
CopyData Range("D88:D94"), "ROLLERS"
CopyData Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim col As String
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
rw = 10
For Each cell In Range("D9:D98")
If Cells(cell.Row, "D").Interior.ColorIndex = 3 Then
col = "G"
Else
col = "F"
End If
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, col).PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 2).Copy
Sh.Cells(rw, "B").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 3).Copy
Sh.Cells(rw, "E").PasteSpecial Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
End Sub


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


Tom Ogilvy

additional target
 
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
if not isEmpty(cell.offset(0,1)) Then
if isNumeric(cell.offset(0,1)) Then
if cell.Offset(0,1) 1 then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, col).PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 2).Copy
Sh.Cells(rw, "B").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 3).Copy
Sh.Cells(rw, "E").PasteSpecial Paste:=xlPasteValues
rw = rw + 1
End if
End if
End if
End If
End If
End If

--
Regards,
Tom Ogilvy

"gavmer " wrote in message
...
Hello all,

I am re-posting this problem as i havent had any luck so far and am in
urgent need of a fix.

The code below copy/pastes on values in column D. How would i amend so
that column E is included also???? (if E 1)

Cheers in advance!!!!!!!


Private Sub CommandButton3_Click()
CopyData Range("D9:D13"), "FEEDER"
CopyData Range("D16:D58"), "MACHINE"
CopyData Range("D63:D73"), "DELIVERY"
CopyData Range("D78:D82"), "PECOM"
CopyData Range("D88:D94"), "ROLLERS"
CopyData Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim col As String
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
rw = 10
For Each cell In Range("D9:D98")
If Cells(cell.Row, "D").Interior.ColorIndex = 3 Then
col = "G"
Else
col = "F"
End If
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, col).PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 2).Copy
Sh.Cells(rw, "B").PasteSpecial Paste:=xlPasteValues
Cells(cell.Row, 3).Copy
Sh.Cells(rw, "E").PasteSpecial Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
End Sub


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





All times are GMT +1. The time now is 03:59 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com