I started out using the following code which I got from this site:
Public Sub CopyDatatoDatabase()
' by Dave Peterson
' The code depends on the last used cell in column A for both
ranges.
Dim rngToCopy As Range
Dim DestCell As Range
Dim wbk As Workbook
On Error Resume Next
Set wbk = Workbooks("somefile.xls")
On Error GoTo 0
If wbk Is Nothing Then
MsgBox "Opening the book now"
Set wbk = Workbooks.Open("somepath\somefile.xls")
End If
With ThisWorkbook.Worksheets("Data")
Set rngToCopy = .Range("A2:I" & .Cells(.Rows.Count,
"A").End(xlUp).Row)
End With
With Workbooks("somefile.xls").Worksheets("Database")
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
rngToCopy.Copy Destination:=DestCell
And it worked fairly well except for a couple of things. The Source
wks has validation. During the pasting process I was prompted to
decide if I wanted to use this or that validation. The Destination
sheet ended up with validation. So, I tried to figure out how to paste
special values only. Also, I want to remove the data from the Source
sheet (effectively move it to the destination) but using rngToCopy.Cut
removed the validation and all formatting from the copied cells on the
source, so I tried .Copy and going back to Delete or Clear the source
sheet but every thing results in destroying the formatting.
Public Sub CopyDatatoDatabase()
Dim rngToCopy As Range
Dim DestCell As Range
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Set wbk1 = ActiveWorkbook
On Error Resume Next
Set wbk2 = Workbooks("somefile.xls")
On Error GoTo 0
If wbk2 Is Nothing Then
Set wbk2 = Workbooks.Open(ActiveWorkbook.Path & "\somefile.xls")
End If
'Subscript out of range
With wbk1.Sheets("Data")
Set rngToCopy = .Range("A2:I" & .Cells(.Rows.Count,
"A").End(xlUp).Row)
End With
With wbk2.Sheets("Database")
If .FilterMode Then .ShowAllData
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
'rngToCopy.Cut Destination:=DestCell
rngToCopy.Copy
'Application Defined or Object Defined Error
DestCell.PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
rngToCopy.Clear
End Sub
Sometimes this works perfectly and other times I get the errors
indicated in the comments. Can anyone help me smooth this out to work
consistently moving the values only and leaving the formatting and
validation behind.
|
Similar Threads
