PDA

View Full Version : Overwrite or save as new



adamsm
02-26-2011, 11:39 AM
Hi,

I'm trying to incorporate the following code to the code embedded in the attached workbook.

The code behind the attached workbook overwrites data if the serial number in Cell O6 of the previous sheet matches with the column B content of OrderData worksheet.

But it copies the column H contents to column E instead of D.

The column K contents to column H instead of E.

Column M contents to column J instead of F.

Column N contenst to K intead of G.

Columns O to L instead of H.

But the following code does copy the data from the previous sheet to the appropriate columns in OrderData sheet.
Sub SaveAndCopy()
On Error Resume Next
Application.ScreenUpdating = False

Dim r As Long
Dim m As Long
Dim n As Long

Dim PreviousWks As Worksheet
Dim OrderWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myRng As Range
Dim myCopy As String
Dim myCell As Range

'cells to copy from Previous sheet - some contain formulas
myCopy = "O6,M14,O9"

Set PreviousWks = Worksheets("Previous")
Set OrderWks = Worksheets("OrderData")

With PreviousWks
Set myRng = .Range(myCopy)

If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the fields!"
Exit Sub
End If
End With

' Use column H because column F contains "Total" (and G is empty)
m = PreviousWks.Range("N" & PreviousWks.Rows.Count).End(xlUp).Row
' Headers are now in row 4
If m = 17 Then
MsgBox "No data", vbExclamation
Exit Sub
End If

r = OrderWks.Range("C" & OrderWks.Rows.Count).End(xlUp).Row + 1
' Copy Code
PreviousWks.Range("F18:F" & m).Copy Destination:=OrderWks.Range("C" & r)
' Copy Quantity
PreviousWks.Range("N18:N" & m).Copy Destination:=OrderWks.Range("G" & r)
' Copy Category as values
PreviousWks.Range("H18:H" & m).Copy
OrderWks.Range("D" & r & ":D" & (r + m - 18)).PasteSpecial Paste:=xlPasteValues
' Copy Description as values
PreviousWks.Range("K18:K" & m).Copy
OrderWks.Range("E" & r & ":E" & (r + m - 18)).PasteSpecial Paste:=xlPasteValues
' Copy Rate as values
PreviousWks.Range("M18:M" & m).Copy
OrderWks.Range("F" & r & ":F" & (r + m - 18)).PasteSpecial Paste:=xlPasteValues
' Copy Value as values
PreviousWks.Range("O18:O" & m).Copy
OrderWks.Range("H" & r & ":H" & (r + m - 18)).PasteSpecial Paste:=xlPasteValues
' Copy Serial number
OrderWks.Range("B" & r & ":B" & (r + m - 18)) = PreviousWks.Range("O6")
' Copy Date
PreviousWks.Range("M14").Copy Destination:=OrderWks.Range("A" & r & ":A" & (r + m - 18))
' Copy Location
OrderWks.Range("I" & r & ":I" & (r + m - 18)) = PreviousWks.Range("O9")

OrderWks.Range("A2:I2").Copy
OrderWks.Range("A" & r & ":I" & (r + m - 18)).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False


End With

PreviousWks.Range("O6").ClearContents
'clear input cells that contain constants
With PreviousMemoWks
On Error Resume Next
With .Range("O6").Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub

How could I extract the part from the above code; that copies the columns from previous sheet and place it in the code in the attached workbook also removing the part that copies the columns to inappropriate columns in OrderData sheet from the previous sheet.