Advanced copying of range from one workbook to another

[Craig Handley]

Hi there,

Sorry if this appears twice - first attempt crashed on posting so trying to
re-submit my question again.

Ok here goes. I'm trying to automate a monthly process where i copy a range
of cells from various sheets in a workbook and paste the values into another
workbook.

So for example I copy A3:A22 from sheet1 in a workbook (lets call it
TESTSOURCE.xls) and paste the values to A15 in sheet1 in another workbook
(lets call it TESTTARGET.xls). I then copy sheet 2 to sheet 2, sheet 3 to
sheet 3 etc etc. I'm sure you get the idea.

I've managed to come up with some code that does this for me (not saying
it's efficient etc but it seems to work). >>>>

Sub Test1()

Workbooks("TESTSOURCE.xls").Activate
Sheets("Sheet1").Range("A3:A22").Copy

Workbooks("TESTTARGET.xls").Activate
Sheets("Sheet1").Range("A15").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False



Workbooks("TESTSOURCE.xls").Activate
Sheets("Sheet2").Range("A3:A22").Copy

Workbooks("TESTTARGET.xls").Activate
Sheets("Sheet2").Range("A15").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

End Sub



However the next month i need to copy Range B3:B22 to B15, the month after
that it's C3:C22 to C15 ... so on and so forth... again i'm sure you see the
pattern/idea.

Now i could just go into the code and use find/replace each month to change
the copy range and destination but i'm trying to find a way to made set the
variable at the top of the code so that i (or other users) only need to
change it once and the code still works correctly. Anything i've tried thus
far keeps giving me range/class errors and the likes so i'm hoping someone
might be able to point me in the right direction?

Even better would be if i could call an input box which asked the user to
enter the source range and then specify the destination cell. Would that be
possible/easy to add in ?

Hope that makes sense but please let me know if anything i'm trying to do is
unclear.

Thanks in advance for your help.

Regards,
Craig

 

[Ron de Bruin]

Hi Craig

In this example the code copy from the activeworkbook

You can repeat this line for the sheets you want
If you want to do the same for all sheets we can make a loop

Wb1.Sheets("Sheet1").Range("A3:A22").copy Wb2.Sheets("Sheet1").Range("A15")

If you want to copy as values post back

Sub test()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Application.ScreenUpdating = False
Set Wb1 = ActiveWorkbook
Set Wb2 = Workbooks("TESTTARGET.xls")

Wb1.Sheets("Sheet1").Range("A3:A22").copy Wb2.Sheets("Sheet1").Range("A15")

Application.ScreenUpdating = True
End Sub

 

[Craig Handley]

Hi Ron,

Thank you for the reply.

I tried that bit of code you supplied but it didn't copy anything into the
TESTTARGET workbook .... not sure if it's because there is no 'paste' etc at
the end of the line.

With the loop suggestion will it still work where i'm not copying every
sheet in the workbook ? They're not even blocked sequential i.e. sheets 3-15.
It would be more like sheets 4-9, 10-18, 20-25, etc ..... not sure it would
tie up easily in the target workbook so might be easier to have line for each
sheet where i can put the sheet names in (they will be the same in both
workbooks e.g. ABFI, ABOP etc).

Any ideas how i could set it up to replace the Range & destination easily
each month ? I messed about with (Range(Cells(3,n),Cells(3,n)) a bit
yesterday and was getting there i think but not sure if that's the correct
path to go down?

My thought then was to prompt the user to enter the period (e.g April to us
= 1, May = 2 etc) .... i could then use that number to get the value for 'n'.

Hope that makes sense and thanks again for your help.

Regards,

Craig.

 

[Craig Handley]

Hi Ron,

Sorry i just re-read your post ... yes i would like to paste the values only.


Thanks,

Craig

 

[Ron de Bruin]

I will reply this evening Graig

 

[Craig Handley]

Ok i've progressed my code a bit to a point where I can get the user to
supply the column they want to copy from (row ref will be static each month)
and the column they want to paste to. It also provides a msgbox to make them
double check they are happy with the input.

I think i've also worked out the paste values bit has to be split over two
lines (is that correct?)

All that remains :-

1) What's the best way to repeat this copy/paste for sheets1, 3, 4, 6, 7, 8,
11, 14, etc ..... can i perform some loop command or do i just repeat the
code as many times as needed and change the sheet names where applicable?

2) Is the code, as it stands, efficient or am i going the long way round on
something ?

3) Should I / could I build something into my inputbox/msgbox code that
checks the user as entered a possible column ref ... i.e. its not left blank
or entered a number in error etc ?


Here is the code so far >>>>

Sub Test1()

Application.ScreenUpdating = False

'Declare & set main variables
Dim wbs As Workbook
Dim wbt As Workbook
Dim sref As String
Dim tref As String

Set wbs = Workbooks("TESTSOURCE.xls")
Set wbt = Workbooks("TESTTARGET.xls")

'Input box for user to identify which column to copy & to where
sref = Application.InputBox("Enter Column Ref you want to copy FROM (e.g.
AE)", "Copy from column", , , , , , 2)
tref = Application.InputBox("Enter Column Ref you want to copy TO (e.g. F)",
"Paste to column", , , , , , 2)

'displays msgbox to confirm selections & perfrom the copy - exit if user
cancels
Dim Msg, Style, Title, Response, MyString
Msg = "You are about to copy data from column" & vbCrLf & vbCrLf &
UCase(sref) & " in TESTSOURCE.xls" & vbCrLf & vbCrLf & "and paste it
to column" & vbCrLf & vbCrLf & UCase(tref) & " in TESTTARGET.xls" &
vbCrLf & vbCrLf & vbCrLf & "Do you want to continue ?"
Style = vbYesNo + vbQuestion + vbDefaultButton1
Title = "Run the Copy & Paste wizard"
Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then

'If user clicks "Yes" then perform the various copy/paste commands on each
sheet.

wbs.Sheets("Sheet1").Range(sref & "3:" & sref & "22").Copy
wbt.Sheets("Sheet1").Range(sref & "3").PasteSpecial Paste:=xlPasteValues


Application.CutCopyMode = False

Else
MsgBox "The copy and paste wizard has been aborted", vbInformation

End If

Application.ScreenUpdating = True

End Sub



Thanks for any help you can offer.


Regards,

Craig

 

[Ron de Bruin]

Hi Craig

You can use a sheets array like this

For Each sh In wbs.Sheets(Array("Sheet1", "Sheet3"))

sh.Range(sref & "3:" & sref & "22").Copy
wbt.Sheets(sh.Name).Range(sref & "3").PasteSpecial Paste:=xlPasteValues

Next sh


I not like the inputbox you use now

Why not copy the cells in from the activecell column
Is there no other way to know the destination column? , maybe the first empty column or so

If you want it like this we can test if the input is a real column
Let me know if you want help with this

 

[Craig Handley]

Hi Ron,

Thank you again for your help, that worked a treat.

I appreciate the comments also about the input box. Unfortunately I'll be
passing this to someone else to use/run and i'm not sure i could trust them
to remember that they had to be on the column they wanted to copy so feels a
bit safer asking them for the column reference. The message box is just so
they can double check what they've selected etc so they only have themselves
to blame if they overwrite a previous months figures.

As regards copying it to the target....the target file is used for forecasts
so in effect it has months with 'actuals' say up to Dec 07 at this point and
then Jan 08 will have 'forecast' figures in it. The copy/paste routine will
lift the Jan 08 actuals and overwrite the forecast figures if that makes
sense. Hence the columns wouldn't be blank so not sure how easy it would be
to identify the correct column.

I'll run with the input box for the moment and see how the users find it ...
if they find it a bit lumpy or not as slick as they'd like then i'll come
back and pick your brains a bit more

Kind regards,

Craig.

 

[Susan]

craig -
i have something like this automated. to find the correct monthly
sheet i have a select case routine based on today's date (figuring
that the person running it will have to wait until after the month end
to do it, so when they want to do january's invoices it will actually
be february......).

here's what i've got, maybe you can adapt it or use some ideas from
it. all my variables are declared in another module.
==========================
Public Sub MonthNumber()

'Set Current Date.
dt = DateTime.Date

'Break up the date.
m = DateTime.Month(dt)

If m <= 1 Then
m = (m + 11)
End If

If m >= 2 And m = 12 Then
'do nothing
Else
m = (m - 1)
End If

If m = 12 Then
y = y - 1
End If

End Sub


Public Sub Select_Sheet()

Set wbMyRPC = Workbooks("RPC Book.xls")

Set Jan = wbMyRPC.Worksheets("Sheet1")
Set Feb = wbMyRPC.Worksheets("Sheet2")
Set Mar = wbMyRPC.Worksheets("Sheet3")
Set Apr = wbMyRPC.Worksheets("Sheet4")
Set May = wbMyRPC.Worksheets("Sheet5")
Set Jun = wbMyRPC.Worksheets("Sheet6")
Set Jul = wbMyRPC.Worksheets("Sheet7")
Set Aug = wbMyRPC.Worksheets("Sheet8")
Set Sep = wbMyRPC.Worksheets("Sheet9")
Set Oct = wbMyRPC.Worksheets("Sheet10")
Set Nov = wbMyRPC.Worksheets("Sheet11")
Set Dec = wbMyRPC.Worksheets("Sheet12")
Set Sum = wbMyRPC.Worksheets("Summary")

Select Case [PrevMonth]
Case Is = 1
Jan.Select
Case Is = 2
Feb.Select
Case Is = 3
Mar.Select
Case Is = 4
Apr.Select
Case Is = 5
May.Select
Case Is = 6
Jun.Select
Case Is = 7
Jul.Select
Case Is = 8
Aug.Select
Case Is = 9
Sep.Select
Case Is = 10
Oct.Select
Case Is = 11
Nov.Select
Case Is = 12
Dec.Select
Case Else
'Error or Else Condition
MsgBox "I can't find the month's spreadsheet!"
End Select

Set rReturn = ActiveSheet.Range("a2")

End Sub

==========================

hope it helps!

susan

 

[Ron de Bruin]

Hi Craig

Dec 07 , Jan 08
Are that the column headers ?

You can use this to test if the entry is a column

Sub test()
Dim sref As String
Dim rng As Range

sref = Application.InputBox("Enter Column Ref you want to copy FROM (e.g.AE)", "Copy from column", , , , , , 2)

On Error Resume Next
Set rng = Range(sref & 1)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "Wrong column entry"
Else
'your code
End If
End Sub