VBA Code to Copy and Paste Data Between Worksheets Using an Input Box to Specify Source and Destination

Q

qaschele11

New Member
Joined
Aug 30, 2011
Messages
5
Hello, I would appreciate your assistance. I have a Workbook for our weekly teaching timetables. Within the Workbook I have:
1. Source Worksheet called "Water"
2. Destination Worksheet called "A3_T-T.
I would like to be able to copy data from "Water" using an Input Box to specify which cells to copy, and paste into "A3_T-T" again using an Input Box to specify which cells to paste to.
I have attempted (many times) to create a code to do this but have not been successful. I humbly apologise if I have not posted this correctly.

Source Worksheet (Water)
Weekly_Teaching_Timetable_Sample.xlsm
ABCDE
5Teacher Water Block Week 1
6A3 Timetable Master ActivityTCHNTTNCT
7Monday, 7 November 2022Monday
8Before 8.00NCT1.00
98:00 - 10:00Water BL Week 1 Intro CPCPWT3028 Theory2.00
10Room BookingM Block - Room M1.01
1110:00 - 12:00Water BL Week 1 CPCPWT3028 Theory2.00
12Room BookingM Block - Room M1.01
1312:00 - 12.45LUNCH
1412.45 - 15.45Water BL - Week 1 CPCPWT3028 Prac (Tapping into Mains)3.00
15Room BookingA Block - A1.15 (Workshop)
1615.45 - 18.00
17Room Booking
18After 18.00
19Room Booking
20Tuesday, 8 November 2022Tuesday
21Before 8.00NCT1.00
228:00 - 10:00Water BL Week 1 CPCPWT3028 Prac (Meters)2.00
23Room BookingA Block - A1.15 (Workshop)
2410:00 - 12:00Water BL Week 1 CPCPWT3028 Prac (Meters)2.00
25Room BookingA Block - A1.15 (Workshop)
2612:00 - 12.45LUNCH
2712.45 - 15.45Water BL Week 1 CPCPWT3028 Theory (Quiz)3.00
28Room BookingM Block - M1.01
2915.45 - 18.00
30Room Booking
31After 18.00
32Room Booking
33Wednesday, 9 November 2022Wednesday
34Before 8.00NCT1.00
358:00 - 10:00Water BL Week 1 CPCPWT3028 Observation (Tapping into Mains)2.00
36Room BookingA Block - A1.15 (Workshop)
3710:00 - 12:00Water BL Week 1 CPCPWT3028 Observation (Tapping into Mains)2.00
38Room BookingA Block - A1.15 (Workshop)
3912:00 - 12.45LUNCH
4012.45 - 15.45Water BL Week 1 CPCPWT3021 Theory3.00
41Room BookingM Block - M1.01
4215.45 - 18.00
43Room Booking
44After 18.00
45Room Booking
46Thursday, 10 November 2022Thursday
47Before 8.00NCT1.00
488:00 - 10:00Water BL Week 1 CPCPWT3021 Theory2.00
49Room BookingM Block - M1.01
5010:00 - 12:00Water BL Week 1 CPCPWT3021 Prac (Noggings / Rough In)2.00
51Room BookingA Block - A1.15 (Workshop)
5212:00 - 12.45LUNCH
5312.45 - 15.45Water BL Week 1 CPCPWT3021 Prac (Noggings / Rough In)3.00
54Room BookingA Block - A1.15 (Workshop)
5515.45 - 18.00
56Room Booking
57After 18.00
58Room Booking
59Friday, 11 November 2022Friday
60Before 8.00NCT1.00
618:00 - 10:00Water BL Week 1 CPCPWT3021 Theory2.00
62Room BookingM Block - M1.01
6310:00 - 12:00Water BL Week 1 CPCPWT3021 Theory2.00
64Room BookingM Block - M1.01
6512:00 - 12.45LUNCH
6612.45 - 15.45Water BL Week 1 CPCPWT3021 Prac (Noggings / Rough In)3.00
67Room BookingA Block - Room A1.15 (Workshop)
6815.45 - 18.00
69Room Booking
70After 18.00
71Room Booking
Water
Cell Formulas
RangeFormula
A7A7=IF(K4="","",K4)
A20A20=IF(K4="","",K4+1)
A33A33=IF(K4="","",K4+2)
A46A46=IF(K4="","",K4+3)
A59A59=IF(K4="","",K4+4)


Destination Worksheet (A3_T-T)
Weekly_Teaching_Timetable_Sample.xlsm
ABCDEFGHIJKLMNOPQRSTUVW
3
4PlumbingVersion:1Week Number:9Week Beginning:##########TOTAL TCH HOURS:  TOTAL NTT HOURS: #REF!TOTAL NCT HOURS:  
5Teacher Teacher OnePrintableTeacher 2PrintableTeacher 3PrintableTeacher 4PrintableTeacher 5PrintableTeacher
6A3 Timetable Master ActivityTCHNTTNCTActivityTCHNTTNCTActivityTCHNTTNCTActivityTCHNTTNCTActivityTCHNTTNCTA3 Timetable Master
7Monday, 7 November 2022MondayMondayMondayMondayMondayMonday, 7 November 2022
8Before 8.00Before 8.00
98:00 - 10:008:00 - 10:00
10Room BookingRoom Booking
1110:00 - 12:0010:00 - 12:00
12Room BookingRoom Booking
1312:00 - 12.45LUNCHLUNCHLUNCHLUNCHLUNCH12:00 - 12.45
1412.45 - 15.4512.45 - 15.45
15Room BookingRoom Booking
1615.45 - 18.0015.45 - 18.00
17Room BookingRoom Booking
18After 18.00After 18.00
19Room BookingRoom Booking
20Tuesday, 8 November 2022TuesdayTuesdayTuesdayTuesdayTuesdayTuesday, 8 November 2022
21Before 8.00Before 8.00
228:00 - 10:008:00 - 10:00
23Room BookingRoom Booking
2410:00 - 12:0010:00 - 12:00
25Room BookingRoom Booking
2612:00 - 12.45LUNCHLUNCHLUNCHLUNCHLUNCH12:00 - 12.45
2712.45 - 15.4512.45 - 15.45
28Room BookingRoom Booking
2915.45 - 18.0015.45 - 18.00
30Room BookingRoom Booking
31After 18.00After 18.00
32Room BookingRoom Booking
33Wednesday, 9 November 2022WednesdayWednesdayWednesdayWednesdayWednesdayWednesday, 9 November 2022
34Before 8.00Before 8.00
358:00 - 10:008:00 - 10:00
36Room BookingRoom Booking
3710:00 - 12:0010:00 - 12:00
38Room BookingRoom Booking
3912:00 - 12.45LUNCHLUNCHLUNCHLUNCHLUNCH12:00 - 12.45
4012.45 - 15.4512.45 - 15.45
41Room BookingRoom Booking
4215.45 - 18.0015.45 - 18.00
43Room BookingRoom Booking
44After 18.00After 18.00
45Room BookingRoom Booking
46Thursday, 10 November 2022ThursdayThursdayThursdayThursdayThursdayThursday, 10 November 2022
47Before 8.00Before 8.00
488:00 - 10:008:00 - 10:00
49Room BookingRoom Booking
5010:00 - 12:0010:00 - 12:00
51Room BookingRoom Booking
5212:00 - 12.45LUNCHLUNCHLUNCHLUNCHLUNCH12:00 - 12.45
5312.45 - 15.4512.45 - 15.45
54Room BookingRoom Booking
5515.45 - 18.0015.45 - 18.00
56Room BookingRoom Booking
57After 18.00After 18.00
58Room BookingRoom Booking
59Friday, 11 November 2022FridayFridayFridayFridayFridayFriday, 11 November 2022
60Before 8.00Before 8.00
618:00 - 10:008:00 - 10:00
62Room BookingRoom Booking
6310:00 - 12:0010:00 - 12:00
64Room BookingRoom Booking
6512:00 - 12.45LUNCHLUNCHLUNCHLUNCHLUNCH12:00 - 12.45
6612.45 - 15.4512.45 - 15.45
67Room BookingRoom Booking
6815.45 - 18.0015.45 - 18.00
69Room BookingRoom Booking
70After 18.00After 18.00
71Room BookingRoom Booking
72Contact Hours0.000.000.000.000.00Contact Hours
73Non Traditional Teaching (Online & RPL)0.000.000.000.000.00Non Traditional Teaching (Online & RPL)
74Non-Contact Hours0.000.000.000.000.00Non-Contact Hours
75Total Hours0.000.000.000.000.00Total Hours
76Overtime/Toil Hours Standard Week0.000.000.000.000.00Overtime/Toil Hours Standard Week
77Overtime Hours/TOIL Pub. Hol WeekStd weekStd weekStd weekStd weekStd weekOvertime Hours/TOIL Pub. Hol Week
7800000
79No. of public holidays or own time PD days Overtime hours are confirmed at the completion of Contact & Non-Contact hours.No. of public holidays or own time PD days
80
81Teacher Signature & DateTeacher Signature & Date
82
83
A3_T-T
Cell Formulas
RangeFormula
O4O4=SUM(C72+G72+K72+O72+S72)
S4S4=SUM(D73+H73+L73+P73+T73)
W4W4=SUM(E74+I74+M74+Q74+U74)
A7A7=IF(K4="","",K4)
V7V7=IF(K4="","",K4)
A20A20=IF(K4="","",K4+1)
V20V20=IF(K4="","",K4+1)
A33A33=IF(K4="","",K4+2)
V33V33=IF(K4="","",K4+2)
A46A46=IF(K4="","",K4+3)
V46V46=IF(K4="","",K4+3)
A59A59=IF(K4="","",K4+4)
V59V59=IF(K4="","",K4+4)
C72,S72,O72,K72,G72C72=SUM(C8:C70)
D73,T73,P73,L73,H73D73=SUM(D8:D70)
E74,U74,Q74,M74,I74E74=SUM(E8:E70)
C75,S75,O75,K75C75=C72+D73+E74
C76,S76,O76,K76,G76C76=IF(OR(B78=1,B78=2,B78=3,B78=4,B78=5),"Non Std week",IF((C72+D73+E74)<=32,0,(C72+D73+E74)-32))
C77,S77,O77,K77,G77C77=IF(B78=1,(C72+D73)-17,IF(B78=2,(C72+D73)-12.5,IF(B78=3,(C72+D73)-8.5,IF(B78=4,(C72+D73)-4,IF(B78=5,(C72+D73)-0,IF(B78=0,"Std week"))))))
G75G75=SUM(G72+H73+I74)
 

Attachments

  • VBA Code.JPG
    VBA Code.JPG
    98.2 KB · Views: 8

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
maybe
VBA Code: 
Sub RangePrompts()
Dim InputRng As Range, ReplaceRng As Range

On Error Resume Next
Set InputRng = Application.InputBox("COPY RANGE:", Type:=8)
If InputRng Is Nothing Then Exit Sub

Set ReplaceRng = Application.InputBox("PASTE RANGE:", Type:=8)
If ReplaceRng Is Nothing Then Exit Sub

InputRng.Copy
ReplaceRng.Cells(1).PasteSpecial Paste:=xlPasteValues

Set Inputrng = Nothing
Set Replacerng = Nothing

End Sub
If user cancels either input, should be ok. If they don't select and hit ok, then I don't know how to get around that.
 
Upvote 0
OK, that is a DisplayWarnings thing. When I make application level changes like that I usually use an error handler to ensure it's reset to normal. Rather than do this in 2 or 3 places (e.g. each time a user can mess up an input) I'd do it like this:
VBA Code: 
Sub RangePrompts()
Dim InputRng As Range, ReplaceRng As Range

On Error GoTo errHandler
Application.DisplayAlerts = False

Set InputRng = Application.InputBox("COPY RANGE:", Type:=8)
Set ReplaceRng = Application.InputBox("PASTE RANGE:", Type:=8)

InputRng.Copy
ReplaceRng.Cells(1).PasteSpecial Paste:=xlPasteValues

exitHere:
Application.DisplayAlerts = True
Set InputRng = Nothing
Set ReplaceRng = Nothing
Exit Sub

errHandler:
If Err.Number <> 424 Then
   MsgBox "Error " & Err.Number & ": " & Err.Description
End If
Resume exitHere

End Sub
User only needs to select one cell in the target sheet (doesn't have to match target size to copy size).
 
Upvote 0
Hello Micron, thank you for taking the time to look at this for me. Sorry, I am very new to vba.
When I run your VBA code, it only selects and pastes within the same spreadsheet. If I try entering the Worksheet name, e.g. Water!B8:E15 as the Source and then A3_T-T!B8, I get an Error Message: Error 1004: To do this, all the merged cells need to be same size. This error seems to pop up no matter how I reference the worksheets.
What I would like to achieve is that the code selects the correct worksheets and the user only has to input the source and destination cell references.
Micron said:
OK, that is a DisplayWarnings thing. When I make application level changes like that I usually use an error handler to ensure it's reset to normal. Rather than do this in 2 or 3 places (e.g. each time a user can mess up an input) I'd do it like this:
VBA Code: 
Sub RangePrompts()
Dim InputRng As Range, ReplaceRng As Range

On Error GoTo errHandler
Application.DisplayAlerts = False

Set InputRng = Application.InputBox("COPY RANGE:", Type:=8)
Set ReplaceRng = Application.InputBox("PASTE RANGE:", Type:=8)

InputRng.Copy
ReplaceRng.Cells(1).PasteSpecial Paste:=xlPasteValues

exitHere:
Application.DisplayAlerts = True
Set InputRng = Nothing
Set ReplaceRng = Nothing
Exit Sub

errHandler:
If Err.Number <> 424 Then
   MsgBox "Error " & Err.Number & ": " & Err.Description
End If
Resume exitHere

End Sub
User only needs to select one cell in the target sheet (doesn't have to match target size to copy size).
Click to expand...
 
Upvote 0
You're not supposed to enter anything. When the input opens, you select the copy range & click OK. When the next input opens, you select the target cell only. If you have to select another sheet, that's OK.
I don't see where you mentioned that you have merged cells, so if you follow that method and it still doesn't work, then maybe that's why. I didn't allow for that and at the moment, don't know how. Suggest you get it working on non-merged cells first.

BTW, I forgot to say that I put that code in a standard module, but it still works if you put it in a sheet module.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
How to Distribute Data in a column/s to other sheets in terms of certain Cell Reference
Replies
0
Views
567
SalamaM
S
V
  • Question Question
Insert data into a second sheet based on a condition
Replies
1
Views
554
vij
V
W
  • Question Question
VBA to map pivot data to another sheet
Replies
0
Views
478
Wafee
W
P
  • Question Question
How do you setup a command button to execute a report that uses formulas, raw data on 1 worksheet, to input data in cells in client report worksheet?
Replies
0
Views
517
Pat1009
P

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top