Paste Multiple Ranges to Different Sheets With Single Button Click

K

KrisKiel

New Member
Joined
Feb 16, 2019
Messages
28
I'm trying to set up a single button that copies various ranges and puts them into different sheets in the first open row. The purpose is to have those copied ranges automatically graph as more rows are added (this part isn't perfect but I'm content with it). There are 5 groups of ranges that have to go into their own 5 specific sheets.

This is what I have so far and it worked at some point for a couple of the sheets individually but I can't remember what I changed and now it doesn't even work when I separate them.


Code: 
Sub Button17_Click()

[LEFT]
[COLOR=#222222][FONT=Verdana]'Trial Scores'
  Application.ScreenUpdating = False
[/FONT][/COLOR][/LEFT]
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet

Dim Rng As Range
    Set Rng = Union(Range("e3:i12"), Range("e14:23"), Range("e25:i34"), Range("e36:i45"), Range("e47:i56"))
  
  Set copySheet = Sheet1
  Set pasteSheet = Sheet2
  Rng.Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

'Trial Block Scores'
   Dim Rng As Range
    Set Rng = Union(Range("e13:i13"), Range("e24:24"), Range("e35:i35"), Range("e46:i36"), Range("e57:i57"))
  Set copySheet = Sheet1
  Set pasteSheet = Sheet3
  Rng.Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

'Trial Block Cold Probe per day'
  Set copySheet = Sheet1
  Set pasteSheet = Sheet4
  copySheet.Range("E13:i13").Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

'Trial Score Cold Probe per trial block DONE'
Dim Rng As Range
    Set Rng = Union(Range("e3:i3"), Range("e14:i14"), Range("e25:i25"), Range("e36:i36"), Range("e47:i47"))
  
  Set copySheet = Sheet1
  Set pasteSheet = Sheet2
  Rng.Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

'Trial Score Cold Probe per day'
   Set copySheet = Sheet1
  Set pasteSheet = Sheet4
  copySheet.Range("E3:i3").Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

End Sub
 
Last edited by a moderator:

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
KrisKiel said:
I'm trying to set up a single button that copies various ranges and puts them into different sheets in the first open row. The purpose is to have those copied ranges automatically graph as more rows are added (this part isn't perfect but I'm content with it). There are 5 groups of ranges that have to go into their own 5 specific sheets.

This is what I have so far and it worked at some point for a couple of the sheets individually but I can't remember what I changed and now it doesn't even work when I separate them.


Code: 
Sub Button17_Click()

[LEFT]
[COLOR=#222222][FONT=Verdana]'Trial Scores'
  Application.ScreenUpdating = False
[/FONT][/COLOR][/LEFT]
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet

Dim Rng As Range

[COLOR=#ff0000]'missing letter
[/COLOR][COLOR=#FF0000]'missing reference sheet[/COLOR]
    Set Rng = Union([COLOR=#FF0000]copySheet.[/COLOR]Range("e3:i12"), Range("e14[COLOR=#ff0000]:23[/COLOR]"), Range("e25:i34"), Range("e36:i45"), Range("e47:i56"))
  
  Set copySheet = Sheet1
  Set pasteSheet = Sheet2
  Rng.Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

'Trial Block Scores'
[COLOR=#ff0000]'   Dim Rng As Range  'duplicate statement[/COLOR]

[COLOR=#ff0000]'missing letter
'missing reference sheet[/COLOR]
    Set Rng = Union([COLOR=#ff0000]copySheet.[/COLOR]Range("e13:i13"), Range("e24[COLOR=#ff0000]:24[/COLOR]"), Range("e35:i35"), Range("e46:i36"), Range("e57:i57"))
  Set copySheet = Sheet1
  Set pasteSheet = Sheet3
  Rng.Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

'Trial Block Cold Probe per day'
  Set copySheet = Sheet1
  Set pasteSheet = Sheet4
  copySheet.Range("E13:i13").Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

'Trial Score Cold Probe per trial block DONE'
Dim Rng As Range
    Set Rng = Union(Range("e3:i3"), Range("e14:i14"), Range("e25:i25"), Range("e36:i36"), Range("e47:i47"))
  
  Set copySheet = Sheet1
  Set pasteSheet = Sheet2
  Rng.Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

'Trial Score Cold Probe per day'
   Set copySheet = Sheet1
  Set pasteSheet = Sheet4
  copySheet.Range("E3:i3").Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  Application.ScreenUpdating = True

End Sub
Click to expand...


Try this:

Code: 
Sub Button17_Click()
    'Trial Scores'
    Application.ScreenUpdating = False
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim rng As Range
    
    Set sh1 = Sheet1
    
[COLOR=#008000]    Set sh2 = Sheet2[/COLOR]
[COLOR=#008000]    Set rng = Union(sh1.Range("e3:i12"), sh1.Range("e14:I23"), sh1.Range("e25:i34"), sh1.Range("e36:i45"), sh1.Range("e47:i56"))[/COLOR]
[COLOR=#008000]    rng.Copy[/COLOR]
[COLOR=#008000]    sh2.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues[/COLOR]
    
    'Trial Block Scores'
[COLOR=#0000ff]    Set sh2 = Sheet3[/COLOR]
[COLOR=#0000ff]    Set rng = Union(sh1.Range("e13:i13"), sh1.Range("e24:i24"), sh1.Range("e35:i35"), sh1.Range("e46:i46"), sh1.Range("e57:i57"))[/COLOR]
[COLOR=#0000ff]    rng.Copy[/COLOR]
[COLOR=#0000ff]    sh2.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues[/COLOR]
    
    'Trial Block Cold Probe per day'
[COLOR=#a52a2a]    Set sh2 = Sheet4[/COLOR]
[COLOR=#a52a2a]    sh1.Range("E13:i13").Copy[/COLOR]
[COLOR=#a52a2a]    sh2.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues[/COLOR]
[COLOR=#a52a2a]    Application.CutCopyMode = False[/COLOR]
[COLOR=#a52a2a]    Application.ScreenUpdating = True[/COLOR]


End Sub
 
Upvote 0
That is beautiful - I have the paste sheets set up as tables though (didn't realize how that affects things), so it's adding them to the first cell below the table - is there a way to add them directly into the table?
 
Upvote 0
KrisKiel said:
That is beautiful - I have the paste sheets set up as tables though (didn't realize how that affects things), so it's adding them to the first cell below the table - is there a way to add them directly into the table?
Click to expand...


Well, that was not in your macro.
It depends for what you want the tables, if you are not going to occupy them as tables, and just store data as a database, it is convenient to use them as a range.
If you are going to leave the table, you should also debug the table, delete the blank rows of the table and when the records are pasted automatically they will be in the table.
 
Upvote 0
Apologies, I didn't know that would change how it worked. Keeping it a table makes the graphs adjust as rows are added - which is very much ideal. The issue is that the very first time I click the button, there is always going to be a blank row in the table (because no data have been recorded) - which then appears on the graph as a 0.
 
Upvote 0
KrisKiel said:
Apologies, I didn't know that would change how it worked. Keeping it a table makes the graphs adjust as rows are added - which is very much ideal. The issue is that the very first time I click the button, there is always going to be a blank row in the table (because no data have been recorded) - which then appears on the graph as a 0.
Click to expand...

Try this

Code: 
Sub Button17_Click()
    'Trial Scores'
    Application.ScreenUpdating = False
    Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, [COLOR=#0000ff]i As Long[/COLOR]
[COLOR=#0000ff]    [/COLOR]
    Set sh1 = Sheet1
    Set sh2 = Sheet2
    Set rng = Union(sh1.Range("e3:i12"), sh1.Range("e14:I23"), sh1.Range("e25:i34"), sh1.Range("e36:i45"), sh1.Range("e47:i56"))
    rng.Copy
[COLOR=#0000ff]    i = 2[/COLOR]
[COLOR=#0000ff]    Do While sh2.Cells(i, "A") <> ""[/COLOR]
[COLOR=#0000ff]        i = i + 1[/COLOR]
[COLOR=#0000ff]    Loop[/COLOR]
    sh2.Range("A" &[COLOR=#0000ff] i[/COLOR]).PasteSpecial xlPasteValues
    
    'Trial Block Scores'
    Set sh2 = Sheet3
    Set rng = Union(sh1.Range("e13:i13"), sh1.Range("e24:i24"), sh1.Range("e35:i35"), sh1.Range("e46:i46"), sh1.Range("e57:i57"))
    rng.Copy
    i = 2
    Do While sh2.Cells(i, "A") <> ""
        i = i + 1
    Loop
    sh2.Range("A" & i).PasteSpecial xlPasteValues
    
    'Trial Block Cold Probe per day'
    Set sh2 = Sheet4
    sh1.Range("E13:i13").Copy
    i = 2
    Do While sh2.Cells(i, "A") <> ""
        i = i + 1
    Loop
    sh2.Range("A" & i).PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question
VBA Code - Copy set range and paste in the next blank row (skipping 1 row)
2
Replies
10
Views
1K
Peter_SSs
Peter_SSs
A
  • Solved
copy paste from one worksheet to other but in different columns
2
Replies
18
Views
724
Joe4
Joe4
G
  • Question
Email from Excel query
Replies
0
Views
167
gmazza76
G
I
  • Solved
Set value for range being copied over with VBA
2
Replies
14
Views
182
ItalianPlatinum
I
T
  • Question
Automation error / file crash
Replies
4
Views
514
Skyybot
Skyybot

Forum statistics

Threads
1,214,839
Messages
6,121,891
Members
449,058
Latest member
Guy Boot

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