Sub to copy n paste as values based on an "instructions" table

M

Max

Seeking help with a sub to automate repetitive "copy n paste special as
values" from various sheets in a "parent" book into several "child" books'
designated sheets

Example:

V_Wealth.xls
contains sheets named:
0
1
2
3
...
20

v=0.xls
contains sheets named:
0
0 (2)
0 (3)

v=1.xls
contains sheets named:
1
1 (2)
1 (3)

What I need to do (done manually now - tedious & eyeball burning)
[all files above are open simultaneously]

Copy range 1:51* from V_Wealth.xls
Sheetname: 0
*entire rows 1 to 51

then paste as values into same range in
v=0.xls
Sheetname: 0

Then copy range 1:51 from V_Wealth.xls
Sheetname: 1

Paste as values into same range in
v=1.xls
Sheetname: 1

and so on ..

In another book, say: CnP.xls,
thought I could frame up an "instructions" table
in sheet: Z, cols A to E, something like this:

CopyFrom.............Range....In Sheet...PasteTo...In Sheet
V_Wealth.xls........1:51...........0............v=0.xls.....0
V_Wealth.xls........1:51...........1............v=1.xls.....1
V_Wealth.xls........1:51...........2............v=2.xls.....2
V_Wealth.xls........1:51...........3............v=3.xls.....3
etc

and then run a sub to carry out all the above copy n paste special as values

I'll ensure that all the files concerned: V_Wealth.xls, v=0.xls, v=1.xls,
etc
are opened simultaneously before running the sub

Any insights appreciated. Thanks.
 
J

Joel

You can add code to automatically open and close the workbooks.

Sub copy_data()

RowCount = 2
With ThisWorkbook.Sheets("instructions")
Do While .Range("A" & RowCount) <> ""

FromBook = .Range("A" & RowCount).Text
FromRows = .Range("B" & RowCount).Text
FromSheet = .Range("C" & RowCount).Text
ToBook = .Range("D" & RowCount).Text
ToSheet = .Range("E" & RowCount).Text

Workbooks(FromBook).Worksheets(FromSheet). _
Rows(FromRows).Copy _
Destination:=Workbooks(ToBook). _
Worksheets(ToSheet).Rows(FromRows)

RowCount = RowCount + 1
Loop
End With
End Su
 
M

Max

Many thanks, Joel. That worked marvellously.
You can add code to automatically open and close the workbooks.

Sounds like a good idea.

How would your code look like, assuming all the files listed in the
instructions table are located in, say:

E:\ReRun\Visits Detail Tracking

I would also need to force recalc, post-pasting (as all files are set to
manual calc mode), and then to save only the destination files (those listed
in col D in the instructions table). Source files listed in col A are to be
closed w/o saving. Thanks.
 
J

Joel

Sub copy_data()

Application.CalculateBeforeSave = True
Folder = "E:\ReRun\Visits Detail Tracking\"

RowCount = 2
With ThisWorkbook.Sheets("instructions")
Do While .Range("A" & RowCount) <> ""

FromBook = .Range("A" & RowCount).Text
FromRows = .Range("B" & RowCount).Text
FromSheet = .Range("C" & RowCount).Text
ToBook = .Range("D" & RowCount).Text
ToSheet = .Range("E" & RowCount).Text

Workbooks.Open Filename:=Folder & FromBook
Workbooks.Open Filename:=Folder & ToBook

Workbooks(FromBook).Worksheets(FromSheet). _
Rows(FromRows).Copy _
Destination:=Workbooks(ToBook). _
Worksheets(ToSheet).Rows(FromRows)

Workbooks(FromBook).Close SaveChanges:=False
Workbooks(ToBook).Close SaveChanges:=True

RowCount = RowCount + 1
Loop
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top