Create Macro to Copy Data from one spreadsheet to another

[Cheri]

Is there a macro I can create in order to copy or move data from one
spreadsheet to another?

We have data sheets showing our reps achievements. The data sheet has been
updated with new objectives and calculations. Some of the cells are locked
and protected. The locked cells are where they cannot be selected, so there
are blocks of cells only that require copying to the new data sheets.

Is there a way to automate this so we don't have to copy and paste the
information manually?

Any help will be greatly appreciated!

Thanks,
Cheri

 

[mudraker]

Yes it can be done


this is an example only as you will need to build the macro to suit
your needs.

or post detailed questions to get more assistance

this copies the contents of sheet 2 cell e3 into sheet 1 cell a1
Sub CopyData()
Dim wS1 As Worksheet
Dim wS2 As Worksheet

Set wS1 = ThisWorkbook.Sheets(1)
Set wS1 = ThisWorkbook.Sheets(2)

wS1.Range("a1").Value = wS2.Range("e3").Value

End Sub

 

[Cheri]

Oh phoo...that is awesome and I will keep that information.

I misinformed you of my need however ( It is between different
workbooks, not worksheets.

Can you assist on this as well? Thank you so much!!!

Cheri

 

[mudraker]

Cheri

Sam principle applies

Sub CopyData()
Dim wS1 As Worksheet
Dim wS2 As Worksheet

Set wS1 = Workbook("Book1.xls").Sheets(1)
Set wS1 = workbook("book2.xls").Sheets("Sheet1")

wS1.Range("a1").Value = wS2.Range("e3").Value

End Sub

 

[Cheri]

One last question. How do I make the macro ask for the name of the workbook
so that it can be entered and the macro applied to the named workbook?

I have 10 different workbooks that I need to set this up for. If I can have
it ask the name of the workbook, it would allow the process to be automated
for each. At least that is how I see it. ) Can this be done?

You are a great help...thank you!!!!

 

[mudraker]

Cheri

To get a workbook name and open that workbook

sFile$ = Application.GetOpenFilename
Workbooks.Open Filename:=sFile

or you could use

sFile$ = msgbox
The user would need to type in the full details


it is also possible to check directories for specific files or part
file names using the DIR command

 

[CheriT63]

Cheri

To get a workbook name and open that workbook

sFile$ = Application.GetOpenFilename
Workbooks.Open Filename:=sFile

or you could use

sFile$ = msgbox
The user would need to type in the full details


it is also possible to check directories for specific files or part
file names using the DIR command

 

[CheriT63]

Hi Mudraker

I am going to give you more details as I am not getting the macro to work.

I have a spreadsheet open named "2006 Scorecard - Final". I have to
transfer information to this open spreadsheet from another spreadsheet. With
just these two spreadsheets open at the same time, I have to copy cells (old
file) C2 to "2006 Scorecard - Final". The same is true with D5:F6 to D5:F6;
D9:E9 to D9:F9; D12:E13 to D13:F14 (yes, it skips a row at this point);
D15:F15 to D16:F16, etc.

Now, where the problem comes in is that I have to do this exact thing to
over 220 reports. I of course use Save As once the data is transferred and
then I do the same to the next file. The destination spreadsheet will ALWAYS
be "2006 Scorecard - Final".

Each of the other files have differing names. I was hoping that if I have
several of these open at one time, I could have a message box pop up to ask
the name of the open workbook that I wish to pull the information from.

Once I input the open workbook name, I would like the macro to do its thing
by copying all pertinent data from the source workbook to the "2006 Scorecard
- Final" workbook.

Please help!

Thanks!!!

 

[mudraker]

Cheri

what about something like this to get the open workbook to copy from

Sub ffff()
Dim ibook As Integer
Dim iResp As Variant
Dim wB As Workbook
Dim wbOpen() As Workbook

ReDim wbOpen(1 To Application.Windows.Count)
For Each wB In Workbooks
Debug.Print wB.Name
ibook = ibook + 1
sTxt$ = sTxt & ibook & " - " & wB.Name & Chr(13)
Set wbOpen(ibook) = wB
Next
iResp = InputBox(sTxt, "Enter Book Number")
If iResp = "" Then
Exit Sub
End If
Set wB = wbOpen(iResp)

End Sub

 

[CheriT63]

Hi mudraker,

When I get to

sTxt$ = sTxt & ibook & " - " & wB.Name & Chr(13)

I get an error that reads: Compile error: Type-declaration character does
not match declared data type.

I apologize that I am such a novice on VBA.

Thanks,
Cheri

 

[mudraker]

My mistake it looks like when i was cleaning up the code before i sent
it i removed the sTxt declaration

Try This

Option Explicit

Sub ffff()
Dim ibook As Integer
Dim iResp As Variant
Dim wB As Workbook
Dim wbOpen() As Workbook
Dim sTxt As String

ReDim wbOpen(1 To Application.Windows.Count)
For Each wB In Workbooks
ibook = ibook + 1
sTxt$ = sTxt & ibook & " - " & wB.Name & Chr(13)
Set wbOpen(ibook) = wB
Next
iResp = InputBox(sTxt, "Enter Book Number")
If iResp = "" Then
Exit Sub
End If
Set wB = wbOpen(iResp)
End Sub

 

[CheriT63]

Oh my gosh...you are AWESOME!!!!!

Now, to transfer or copy information from cells in workbook A to workbook B,
I know the cells, etc. But, how do I set up the copy and paste? How do I
tell the macro to reference the source workbook to the destination workbook?

You are amazing! I cannot thank you enough for this info!!!!

 

[mudraker]

Cheri

there are many ways to copy data between sheets and workbooks.

here are a few examples - some of them are taken from macros that
have build and will need to be modified to suit your needs.

You can copy single cells, ranges of cells, entire sheets and place th
data into another sheet with & with out the formating.

If you can give a few examples of the cells that need to copy from an
to I will give you more specific samples. Please include workbook
worksheet names

=============
Sub ffff()
Dim ibook As Integer
Dim iResp As Variant
Dim wB As Workbook
Dim wbOpen() As Workbook
Dim wsFrom As Worksheet
Dim wsTo As Worksheet

Dim sTxt As String

ReDim wbOpen(1 To Application.Windows.Count)
For Each wB In Workbooks
ibook = ibook + 1
sTxt$ = sTxt & ibook & " - " & wB.Name & Chr(13)
Set wbOpen(ibook) = wB
Next
iResp = InputBox(sTxt, "Enter Book Number")
If iResp = "" Then
Exit Sub
End If
'sheets(1) can be a sheet number or sheet name
Set wsFrom = wbOpen(iResp).Sheets(1)
Set wsTo = ThisWorkbook.Sheets("Sheet1")
wsTo.Range("a1").Value = wsFrom.Range("a1").Value
End Sub

Sub copyRng()
Worksheets("Sheet1").Range("C1:C10").Cop
Worksheets("Sheet2").Range("G1")
End Sub


Option Explicit

Sub CopyRow()
Dim wS1 As Worksheet
Dim wS5 As Worksheet
Dim lRow As Long
Dim iValC As Integer
Dim iValAE As Integer
Dim Rng As Range

Set wS1 = Sheets("Sheet1")
Set wS5 = Sheets("sheet5")

iValC = wS1.Range("g3").Value
iValAE = wS1.Range("ae5").Value

For Each Rng In wS5.Range("c2:c" _
& wS5.Cells(Rows.Count, _
"a").End(xlUp).Row)
If Rng.Value = iValC Then
If Cells(0, "ae").Value = iValAE Then
wS5.Rows(Rng.Row).Copy wS1.Rows(19)
Exit For
End If
End If
Next Rng
End Su

 

[CheriT63]

Hi again!

Okay, I have to copy the following from an open workbook whose name will
constantly change. So, using the code you wrote to get the open workbook
name, can we then have it use that name throughout?

The destination workbook will always be "2006 CSR Scorecard - Final.xls"

The source workbook will always be the chosen open workbook name from the
following code you wrote:

Option Explicit

Sub ffff()
Dim ibook As Integer
Dim iResp As Variant
Dim wB As Workbook
Dim wbOpen() As Workbook
Dim sTxt As String

ReDim wbOpen(1 To Application.Windows.Count)
For Each wB In Workbooks
ibook = ibook + 1
sTxt$ = sTxt & ibook & " - " & wB.Name & Chr(13)
Set wbOpen(ibook) = wB
Next
iResp = InputBox(sTxt, "Enter Book Number")
If iResp = "" Then
Exit Sub
End If
Set wB = wbOpen(iResp)

Now...the cells I need to copy will always go from the worksheet in the
source workbook named "YTD". They will always go to a worksheet in the "2006
CSR Scorecard - Final.xls" workbook named "YTD".

The cells I need to copy and paste are as follows:
C2=C2
D5:F6=D5:F6
D9:F9=D9:F9
D12:F13=D13:F14
D15:F15=D16:F16
D17:F17=D18:F18
D20:F20=D21:F21
D23:F24=D24:F25

That's it. I would love for it to include code that once completed it would
open the Save As dialog box for the destination workbook so it wouldn't
accidentally get saved over the blank file.

You have been so helpful and I really appreciate it!!!! I am sorry I am
such a pain.

Thanks agina,
Cheri

 

[mudraker]

Cheri

Please note: If when savingas you will be following a standard naming
format then the code can be built to also calculate the new file name
instead of using Application.GetSaveAsFilename()

Code can also be added to check if a file exists.


try this
The code copies data and formatting.

Sub ffff()
Dim ibook As Integer
Dim iResp As Variant
Dim wB As Workbook
Dim wbOpen() As Workbook
Dim wbTo As Workbook
Dim wsFrom As Worksheet
Dim wsTo As Worksheet
Dim sTxt As String
Dim sFname As String

Set wbTo = Workbook("2006 CSR Scorecard - Final.xls")
Set wsTo = wbTo.Sheets("YTD")

' get list of open workbooks
ReDim wbOpen(1 To Application.Windows.Count)
For Each wB In Workbooks
If wB.Name <> wbTo.Name Then
ibook = ibook + 1
sTxt$ = sTxt & ibook & " - " & wB.Name & Chr(13)
Set wbOpen(ibook) = wB
End If
Next
' get copy from workbook from user
iResp = InputBox(sTxt, "Enter Book Number")
If iResp = "" Then
Exit Sub
End If

Set wsFrom = wbOpen(iResp).Sheets("YTD")
'copy data between workbooks
wsFrom.Range("c2").Copy wsTo.Range("c2")
wsFrom.Range("D5:F6").Copy wsTo.Range("D5:F6")
wsFrom.Range("D9:F9").Copy wsTo.Range("D9:F9")
wsFrom.Range("D12:F13").Copy wsTo.Range("D13:F14")
wsFrom.Range("d15:F15").Copy wsTo.Range("D16:F16")
wsFrom.Range("D17:F17").Copy wsTo.Range("D18:F18")
wsFrom.Range("D20:F20").Copy wsTo.Range("D21:F21")
wsFrom.Range("D23:F24").Copy wsTo.Range("D24:F25")
'save copied data workbook
sFname$ = Application.GetSaveAsFilename()
If sTxt = "False" Then
MsgBox "no code yet to deal with user selecting cancel button",
vbCritical
End
End If
wbTo.SaveAs Filename:=sFname
End Sub

 

[CheriT63]

Okay, the only thing I have run into now is that the code makes me rename the
file and if I close out of the Save As dialog box without giving a new name,
it automatically names the file "False.xls".

After that, when I want to run the macro again, it wants to open False.xls
to run the macro or it won't run.

I sure wish I knew what you know!!!

Thanks,
Cheri

 

[mudraker]

Cheri

I coded it that way so that you would not get the problem you are
having but I used the wrong variable name in the test

Replace
If sTxt = "False" Then
with
If sFname = "False" Then

That part of the code should then read like this.


sFname$ = Application.GetSaveAsFilename()
If sFname = "False" Then
MsgBox "No code to deal with user selecting cancel button", vbCritical
End ' stops macro
End If

You can change the warning message or remove the MsgBox line of code if
desired

 

[Cheri]

This is great. Now, how can I move worksheets from the old spreadsheet to
the new using code? I only have one worksheet in the destination workbook.
It is the YTD worksheet which works just fine now.

There may be one or as many as five additional worksheets in the old
workbooks. Can you help me with code to move them to the 2006 CSR Scorecard
- Final.xls?

My final challeng is then to paste a link from YTD!C2 to D3 on all other
worksheets.

I hope I am not giving you a headache with all of my requests!!!

Thanks again,
Cheri

 

[mudraker]

Cheri

I am not sure in what you are trying to acheive or mean in linking
YTD!C2 to D3 on all other worksheets.


To copy/move sheets

Add a new variable at the stat of the macro
Dim wsTo As Worksheet

Add this code within the macro where you want to cop/move the sheets.
Selcting the copy or move line of code as required

'copy/move sheets
For Each wS In wbFrom.Worksheets
wS.Move After:=wbTo.Sheets(wbTo.Sheets.Count)
'wS.Copy After:=wbTo.Sheets(wbTo.Sheets.Count)
Next wS


In the following macro I added the code to move/copy the sheets after
copying the various cell data. My code copies/moves all sheets
including the YTD sheet.


Sub ffff()
Dim ibook As Integer
Dim iResp As Variant
Dim wB As Workbook
Dim wbOpen() As Workbook
Dim wbTo As Workbook
Dim wsFrom As Worksheet
Dim wsTo As Worksheet
Dim sTxt As String
Dim sFname As String

Set wbTo = Workbook("2006 CSR Scorecard - Final.xls")
Set wsTo = wbTo.Sheets("YTD")

' get list of open workbooks
ReDim wbOpen(1 To Application.Windows.Count)
For Each wB In Workbooks
If wB.Name <> wbTo.Name Then
ibook = ibook + 1
sTxt$ = sTxt & ibook & " - " & wB.Name & Chr(13)
Set wbOpen(ibook) = wB
End If
Next
' get copy from workbook from user
iResp = InputBox(sTxt, "Enter Book Number")
If iResp = "" Then
Exit Sub
End If

Set wsFrom = wbOpen(iResp).Sheets("YTD")
'copy data between workbooks
wsFrom.Range("c2").Copy wsTo.Range("c2")
wsFrom.Range("D5:F6").Copy wsTo.Range("D5:F6")
wsFrom.Range("D9:F9").Copy wsTo.Range("D9:F9")
wsFrom.Range("D12:F13").Copy wsTo.Range("D13:F14")
wsFrom.Range("d15:F15").Copy wsTo.Range("D16:F16")
wsFrom.Range("D17:F17").Copy wsTo.Range("D18:F18")
wsFrom.Range("D20:F20").Copy wsTo.Range("D21:F21")
wsFrom.Range("D23:F24").Copy wsTo.Range("D24:F25")

'copy/move sheets
For Each wS In wbFrom.Worksheets
'wS.Move After:=wbTo.Sheets(wbTo.Sheets.Count)
wS.Copy After:=wbTo.Sheets(wbTo.Sheets.Count)
Next wS

'save copied data workbook
sFname$ = Application.GetSaveAsFilename()
If sTxt = "False" Then
MsgBox "no code yet to deal with user selecting cancel button",
vbCritical
End
End If
wbTo.SaveAs Filename:=sFname
End Sub

 

[Cheri]

Hi Mudraker, I'm back )

This macro works great. The only problem is that the macro does not stay
with the original workbook. As soon as I use the Save As feature, the macro
then belongs to the new workbook. So, when I try to access it again, using
the original document, it wants to open the recent saved document.

Is there a line or two that I can add to the macro to keep the reference
attached to the original?

I hope this made sense )

Thanks,
Cheri