Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy data from one sheet to another
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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copy rows from one Data sheet to another sheet based on cell conte | Excel Discussion (Misc queries) | |||
Copy Data from Sheet 1 to Empty Cell in Sheet 2 | Excel Programming | |||
Auto copy cell data from source sheet to another wrkbook sheet | Excel Programming | |||
How can i copy data from a tabbed working sheet to a summary sheet | Excel Discussion (Misc queries) | |||
how to copy a cell with formula from sheet 1 (data is all vertical) into sheet 2 | Excel Worksheet Functions |