Paste Multiple Ranges to Different Sheets With Single Button Click

KrisKiel

New Member
Joined
Feb 16, 2019
Messages
25
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:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,573
Office Version
2007
Platform
Windows
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

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
 

KrisKiel

New Member
Joined
Feb 16, 2019
Messages
25
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?
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,573
Office Version
2007
Platform
Windows
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?

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.
 

KrisKiel

New Member
Joined
Feb 16, 2019
Messages
25
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.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
9,573
Office Version
2007
Platform
Windows
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.
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
 

Forum statistics

Threads
1,084,878
Messages
5,380,415
Members
401,673
Latest member
Ali Balleya

Some videos you may like

This Week's Hot Topics

Top