Logo 
Search:

MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

Copy_To_Another_Workbook

  Asked By: Eden    Date: Oct 07    Category: MS Office    Views: 668
  

Can you all help me on this code, where to improve?

The idea is to transfer the selected range from one workbook to another
,

and if the criteria set is the same it will keep on updating the
existing data,

but if the criteria is different then it will insert the copy range on
top of the current data


Sub Copy_To_Another_Workbook()

Dim SourceRange As Range

Dim DestRange As Range

Dim DestWB As Workbook

Dim DestSh As Worksheet

Dim Lr As Long

Dim irow As Integer

Dim ws1 As Worksheet, ws2 As Worksheet

With Application

.ScreenUpdating = False

.EnableEvents = False

End With


Set DestWB = Workbooks.Open("N:\Shift production report
V11.2\PlannersPerformance.xls")

Set SourceRange =
ThisWorkbook.Sheets("shiftreport").Range("A541:Q560")

Set DestSheet = DestWB.Worksheets("PLANNER PRODUCTION")

On Error Resume Next


If ThisWorkbook.Sheets("shiftreport").Range("b541") =
DestSheet.Range("b2").Value Then

Set DestRange = DestSheet.Range("A" & Lr + 2)

SourceRange.Copy

DestRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:= _

xlNone, SkipBlanks:=yes, Transpose:=False

Application.CutCopyMode = False

DestWB.Close savechanges:=True

Else

Set DestRange = DestSheet.Range("A" & Lr + 2)

SourceRange.Copy

Selection.Insert Shift:=xlDown

DestRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:= _

xlNone, SkipBlanks:=yes, Transpose:=False

Application.CutCopyMode = False

DestWB.Close savechanges:=True

With Application

.ScreenUpdating = True

.EnableEvents = True


End With

End If

End Sub

Share: 

 

9 Answers Found

 
Answer #1    Answered By: Gloria Cook     Answered On: Oct 07

There is certainly some basic tidying you should do in and around your IF
statement.

I suspect that your indenting might not be consistent. (Hard to tell in an
e-mail, seeing they tend to get mucked up.) But your re-enabling of the
events and screen updating  is in the "else" part of the IF. It shouldn't be
in the IF at all. So let's move it. I'll put leading full-stops on the
lines to attempt to keep the indenting intact.

. If ThisWorkbook.Sheets("shiftreport").Range("b541") =
DestSheet.Range("b2").Value Then
. Set DestRange = DestSheet.Range("A" & Lr + 2)
. SourceRange.Copy
. DestRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks:=yes, Transpose:=False
. Application.CutCopyMode = False
. DestWB.Close savechanges:=True
. Else
. Set DestRange = DestSheet.Range("A" & Lr + 2)
. SourceRange.Copy
. Selection.Insert Shift:=xlDown
. DestRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks:=yes, Transpose:=False
. Application.CutCopyMode = False
. DestWB.Close savechanges:=True
. End If
. With Application
. .ScreenUpdating = True
. .EnableEvents = True
. End With

Now look at the true  and false  parts of the IF - they're almost identical.
In fact, the only difference is the "insert" statement. So, move the common
code outside the IF.

. If ThisWorkbook.Sheets("shiftreport").Range("b541") <>
DestSheet.Range("b2").Value Then
. Selection.Insert Shift:=xlDown
. End If
. SourceRange.Copy
. Set DestRange = DestSheet.Range("A" & Lr + 2)
. DestRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks:=yes, Transpose:=False
. Application.CutCopyMode = False
. DestWB.Close savechanges:=True

But ... does your code  actually work? I suspect that it doesn't.

Your insert  statement is Selection.Insert. I would have expected the
selection to be in your source sheet, not your destination, which means the
insert will happen in the wrong place. Don't you want DestRange.Insert?

Also, your insert is presumably only inserting one row, but your copy  is
copying 20 rows. This is presumably wrong.

Also, you have a variable "Lr" which is used to control row numbers, but
appears to be left at zero the whole time.

Lastly, a hard-coded range  such as "A541:Q560" - particularly when this is
not the only use of 541 - is definitely not a good idea. Unless you are
absolutely sure that the rest of the sheet will stay as it is, you should
use a named range for this area.

Lastly, you should never use "On error  Resume Next" unless there is a
specific technical reason to do so. If you get run-time errors, they are
usually due to something you are doing wrong. If you need it at all, put it
just before the statement that needs it, then turn error checking back on
immediately after the statement involved.

 
Answer #2    Answered By: Kaysah Mohammad     Answered On: Oct 07

but the problem is whenever the value is not the same the the range  that
being coped into will turned to #REF



How to avoid this ? is it because the copy  range is from a range that
have links/formula?





. If ThisWorkbook.Sheets("shiftreport").Range("b541") <>
DestSheet.Range("b2").Value

 
Answer #3    Answered By: Gus Jones     Answered On: Oct 07

That sort of error  is not likely to happen if your cell references
are in the "R1C1" format. That takes out the actual letter labels
of the columns as well as the exact row numbers--and refers to the
cells in comparison to each other . . . so, have a look at the VBA
Help listing under "Address Property", which lists this series of
ways of identifying the cells:

Set mc = Worksheets("Sheet1").Cells(1, 1)
MsgBox mc.Address() ' $A$1
MsgBox mc.Address(RowAbsolute:=False) ' $A1
MsgBox mc.Address(ReferenceStyle:=xlR1C1) ' R1C1
MsgBox mc.Address(ReferenceStyle:=xlR1C1, _
RowAbsolute:=False, _
ColumnAbsolute:=False, _
RelativeTo:=Worksheets(1).Cells(3, 3)) ' R[-2]C[-2]

Then select the method which you need and use it for your copy
and paste  process.

 
Answer #4    Answered By: Hisa Yoshida     Answered On: Oct 07


I just noticed that you also mentioned "links" as well as cell
references. It does help  to put the "link" references into
variables, and use range  names in those variables, if that fits.
When the data  from which the formula is using is also in the new
workbork, as long as it has the same range name, it will check the
range on the new workbook, if it's coded that way. I have to do
that in the programming that I've been doing, so if that's the case,
let me know and I'll give you the steps--assuming that what I've
already suggested doesn't answer your question.

As always, I have to add another vote of confidence about this
group--heheh, where I miss, others see. After all, this is where I
learned.

 
Answer #5    Answered By: Courtney Hughes     Answered On: Oct 07

You need to post the code  you're using now, so we can look at it.

 
Answer #6    Answered By: Hiroshi Yoshida     Answered On: Oct 07

I still cannot figure this out and its become worse , im still a new to
this actually





"If ThisWorkbook.Sheets("shiftreport").Range("B541") <>
DestSheet.Range("B2").Value Then"

This is where I need to make a criteria  , if a value in cell ("B541")
did not the same with the value in "B2" then the macro should insert  the
copy range  instead of overriding the existing data  .



But if both have the same criteria value then it will continue updating
the range ( or by overriding the existing data )



Attached code  however copy  and paste  a value that tends to change to
#REF ( is it because the "copy range" is a link and formula data ??) ,



Set SourceRange = ThisWorkbook.Sheets("shiftreport").Range("A541:Q560")

From the above code , I set  a range from A541:Q560 , because sometimes
the data can be up to 20 rows , but not necessarily.

The range is actually a summary and coming from a link and formula





Below is the problems code :



Sub Copy_To_Another_Workbook()

Dim SourceRange As Range

Dim DestRange As Range

Dim DestWB As Workbook

Dim DestSh As Worksheet

Dim irow As Integer

Dim LastRow As Long





With Application

.ScreenUpdating = False

.EnableEvents = False



End With





If bIsBookOpen_RB("C:\Documents and
Settings\mohdnoor\Desktop\plannersperformance.xls") Then

Set DestWB = Workbooks("C:\Documents and
Settings\mohdnoor\Desktop\plannersperformance.xls")

Else

Set DestWB = Workbooks.Open("C:\Documents and
Settings\mohdnoor\Desktop\plannersperformance.xls")

End If







Set SourceRange =
ThisWorkbook.Sheets("shiftreport").Range("A541:Q560")

Set DestSheet = DestWB.Worksheets("PLANNER PRODUCTION")

Set DestRange = DestWB.Worksheets("PLANNER PRODUCTION").Range("A2")







If ThisWorkbook.Sheets("shiftreport").Range("B541") <>
DestSheet.Range("B2").Value Then

SourceRange.Copy

DestRange.Insert Shift:=xlDown



Else

SourceRange.Copy

Lr = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row



Set DestRange = DestSh.Range("A" & Lr + 1)





DestRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks:=yes, Transpose:=False



Application.CutCopyMode = False

DestWB.Close savechanges:=True









With Application

.ScreenUpdating = True

.EnableEvents = True





End With

End If







End Sub

 
Answer #7    Answered By: Eustatius Bakker     Answered On: Oct 07

I still cannot figure this out and its become worse , im still a new to
this actually





"If ThisWorkbook.Sheets("shiftreport").Range("B541") <>
DestSheet.Range("B2").Value Then"

This is where I need to make a criteria  , if a value in cell ("B541")
did not the same with the value in "B2" then the macro should insert  the
copy range  instead of overriding the existing data  .



But if both have the same criteria value then it will continue updating
the range ( or by overriding the existing data )



Attached code  however copy  and paste  a value that tends to change to
#REF ( is it because the "copy range" is a link and formula data ??) ,



Set SourceRange = ThisWorkbook.Sheets("shiftreport").Range("A541:Q560")

From the above code , I set  a range from A541:Q560 , because sometimes
the data can be up to 20 rows , but not necessarily.

The range is actually a summary and coming from a link and formula





Below is the problems code :



Sub Copy_To_Another_Workbook()

Dim SourceRange As Range

Dim DestRange As Range

Dim DestWB As Workbook

Dim DestSh As Worksheet

Dim irow As Integer

Dim LastRow As Long





With Application

.ScreenUpdating = False

.EnableEvents = False



End With





If bIsBookOpen_RB("C:\Documents and
Settings\mohdnoor\Desktop\plannersperformance.xls") Then

Set DestWB = Workbooks("C:\Documents and
Settings\mohdnoor\Desktop\plannersperformance.xls")

Else

Set DestWB = Workbooks.Open("C:\Documents and
Settings\mohdnoor\Desktop\plannersperformance.xls")

End If







Set SourceRange =
ThisWorkbook.Sheets("shiftreport").Range("A541:Q560")

Set DestSheet = DestWB.Worksheets("PLANNER PRODUCTION")

Set DestRange = DestWB.Worksheets("PLANNER PRODUCTION").Range("A2")







If ThisWorkbook.Sheets("shiftreport").Range("B541") <>
DestSheet.Range("B2").Value Then

SourceRange.Copy

DestRange.Insert Shift:=xlDown



Else

SourceRange.Copy

Lr = DestSheet.Cells(Rows.Count, "A").End(xlUp).Row



Set DestRange = DestSh.Range("A" & Lr + 1)





DestRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats,
Operation:=xlNone, SkipBlanks:=yes, Transpose:=False



Application.CutCopyMode = False

DestWB.Close savechanges:=True









With Application

.ScreenUpdating = True

.EnableEvents = True





End With

End If







End Sub

 
Answer #8    Answered By: Ismet Yilmaz     Answered On: Oct 07

Let me first see if I understand what you're trying to do, step
by step, ok?

If I understood you, you might be updating  the other rows besides
the inserted onese, so you can do that first. That is, copy  and
paste or transfer  otherwise, the updated data  from rows B2 to B540,
as well as the rows that MIGHT follow the insert,if that's relevant;

THEN IF the value in "B541" doesNOT match the value in "B2",
then you want to insert  the cells from "A541:Q560" on the first
sheet to the second sheet;

On the other hand, if the value in "B541" DOES match the value
in "B2", then you want to COPY OVER the cells on the second sheet
with the values from "A541:Q560" on the first sheet.

If that is the task, then, why not take the steps of comparing
those values first? Or, at least find out the values of B2 and B541
and put them into variables first to be compared as needed.

Then, count the rows from A541 to the last row of the data you
need to transfer . . . a simple loop could do that. That way, you
don't have to worry about how many rows you're inserting . . . it
would be the exact number of rows.

Then you can, check the values in B2 and B541 and compare them to
see it they match.

If they do, then you can write the code  for the COPY OVER version
of the data transfer, then exit that sub after that portion of code.

If they DON'T match, then you can do a GOTO to skip over the
COPY OVER version of the data transfer and then set  up the beginning
of the INSERT ROW-DATA at that GOTO point, labeling it in a way that
you like.

Looking at the code you have below, it looks like to me that
you're trying to do too much at once. It might be possible to do it
that way, but taking it step-wise might help  solve the problem until
you see a better way.

After all, if I understood you, you're only moving about 20 rows
of data, from column A to Q . . . which isn't all that much, so it
should be very fast to do. If you were moving 20,000 rows, then it
might take a bit more to figure out the exact parameters.

You might also do use the macro recorder and manually do each
of the steps and look at the code that the editor generates.

Also, you might consider moving the exact values, using the
paste-value version of the copy-paste . . . and then fill down the
formulas if they are the same in each column, or add them back in
with code. That should take most, if not all, of the #REF errors
out--you'd be copying the raw data and then using new formulas.

Also, remember that the formulas can be written in R1C1 format
which is much easier to transfer across sheets in the first place.

Hope those ideas help a bit, and please clarify, if I've missed
something, or misunderstood your task.

 
Answer #9    Answered By: Malcolm Carter     Answered On: Oct 07

Are you stepping the code  through to see precisely what it's (not) doing?
Either put a breakpoint on the code, or insert  a Stop statement to take it
into debug mode.

 
Didn't find what you were looking for? Find more on Copy_To_Another_Workbook Or get search suggestion and latest updates.

Related Topics:




 

Related Post