command button move worksheet from one workbook to another

[Guest]

This will prolly go unanswered but..I have worksheets emp1 thru emp24. I
would like to place a command button on each sheet that when clicked will
allow me to move the sheet to another excel file that had tne same name but
is in a different folder. In addition I'd like the worksheet to take the
place of one of the worksheets in the new file as long as the worksheet does
not have a value in cell B4. So if file 1 emp5 is moved to file 2 it looks
for the first sheet with an empty B4 in file 2 and replaces it with the
worksheet from file1. So in theory file1 emp5 could become file2 emp8.I'd
also like file1 emp5 to retain its name but be clear of information in
unlocked cells (if it matters the worksheets are protected). Each employee
has his own worksheet but may switch teams at any time. Each team has it's
own file. I know I'm prolly asking for way too much here.

 

[Nick Hodge]

Not way too much of Excel, but it appears you want an application building
from scratch, many people earn a living from this activity.

Have you attempted anything yourself to start this project? We can then
possibly help you with specific issues

--
HTH
Nick Hodge
Microsoft MVP - Excel
Southampton, England
(e-mail address removed)

 

[Guest]

Can I send you the file I created and perhaps you can provide suggestions?

 

[Tom Ogilvy]

Wouldn't it be easier just to copy the information

Update sList to reflect all the unlocked cells with information to be moved

Dim sList as String, Sh as Worksheet
Dim bkSrc as Workbook, bkDest as Workbook
Dim sh1 as Worksheet, fName as Variant
Dim bFound as Boolean, cell as Range
sList = "A1,B4,C11,F14,G3,R12"
set sh = Activesheet
set bksrc = sh.parent
fName = Application.GetOpenFileName()
if fName = False then Exit sub
set bkDest = Workbooks.Open(fName)

bFound = False
for each sh1 in bkDest.worksheets
if sh1.Range("B4").Value = "" then
bFound = True
for each cell in Sh.Range(sList)
sh1.Range(cell.Address).Value = cell.Value
next
exit for
end if
Next
if bFound then
sh.Range(sList).ClearContents
else
msgbox "No Openings in " & bkDest.name
end if
bkDest.Close SaveChanges:=True
bk.Src.Save