Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Excel > Excel Programming

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 01-29-2019, 03:20 PM
BCrenshaw BCrenshaw is offline Windows 7 64bit Office 2016
Novice
 
Join Date: Jun 2016
Posts: 3
BCrenshaw is on a distinguished road
Default Macro to create two copies of worksheet, then run macro.


Hi, I searched the forum but haven't been able to figure out what I'm looking for. I'm sure this is super simple for most of you but my excel skills are hit or miss. What I'm looking to do is make two copies of a worksheet (to make three total) then rename them based on the file name. Then run the same three macros in each one of the three worksheets. Pretty simple right? But I discovered that the copying part throws an error when I use it in other files because the actual file name of the original file is part of the code. how can I get this to work on any file name? below is the code, and attached is a similar file that I want to use this macro on. I can't attach the original file this macro was created on because I accidentally overwrote it Thank you.


Code:
Sub ThreeWaySplit()
'
' ThreeWaySplit Macro
'

'
    Sheets("DL_8_Auburn Oven 3 TUS_01282019").Select
    Sheets("DL_8_Auburn Oven 3 TUS_01282019").Copy After:=Sheets(1)
    Sheets("DL_8_Auburn Oven 3 TUS_01282019").Select
    Sheets("DL_8_Auburn Oven 3 TUS_01282019").Name = "Auburn Oven 3 TUS_260"
    Range("F33").Select
    Sheets("DL_8_Auburn Oven 3 TUS_0128 (2").Select
    Sheets("DL_8_Auburn Oven 3 TUS_0128 (2").Name = "Auburn Oven 3 TUS_350"
    Sheets("Auburn Oven 3 TUS_260").Select
    Sheets("Auburn Oven 3 TUS_260").Name = "Auburn Oven 3 TUS_260"
    Sheets("Auburn Oven 3 TUS_260").Select
    Sheets("Auburn Oven 3 TUS_260").Copy After:=Sheets(2)
    Sheets("Auburn Oven 3 TUS_260 (2)").Select
    Sheets("Auburn Oven 3 TUS_260 (2)").Name = "Auburn Oven 3 TUS_450"
    Sheets("Auburn Oven 3 TUS_260").Select
    Application.Run "PERSONAL.XLS!Survey40wire"
    Application.Run "PERSONAL.XLS!Survey20WireShrinkRunFirst"
    Application.Run "PERSONAL.XLS!Survey20WirePortaitRunSecond"
    Sheets("Auburn Oven 3 TUS_350").Select
    Application.Run "PERSONAL.XLS!Survey40wire"
    Application.Run "PERSONAL.XLS!Survey20WireShrinkRunFirst"
    Application.Run "PERSONAL.XLS!Survey20WirePortaitRunSecond"
    Sheets("Auburn Oven 3 TUS_450").Select
    Application.Run "PERSONAL.XLS!Survey40wire"
    Application.Run "PERSONAL.XLS!Survey20WireShrinkRunFirst"
    Application.Run "PERSONAL.XLS!Survey20WirePortaitRunSecond"
End Sub
Attached Files
File Type: xlsx DL_7_Renton Oven 1 TUS_01282019_101622.xlsx (54.4 KB, 1 views)

Last edited by BCrenshaw; 01-30-2019 at 10:31 AM.
Reply With Quote
  #2  
Old 01-30-2019, 12:55 AM
Pecoflyer's Avatar
Pecoflyer Pecoflyer is offline Windows 7 64bit Office 2010 64bit
Moderator
 
Join Date: Nov 2011
Location: Brussels Belgium
Posts: 2,294
Pecoflyer is a glorious beacon of lightPecoflyer is a glorious beacon of lightPecoflyer is a glorious beacon of lightPecoflyer is a glorious beacon of lightPecoflyer is a glorious beacon of light
Default

Hi,
When posting code, please wrap it with code tags ( Edit code - select code - click the #button.)
It keeps the macro's structure and makes it easy to copy and handle.
Thank you
__________________
Problem solved ? Let others know by clicking " Thread Tools" then " Mark thread as solved".( This can be undone if need be)
Want to thank for the help received ? Click the scales symbol in the upper right corner of a post from the person you want to thank.
Reply With Quote
  #3  
Old 01-30-2019, 07:05 AM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 656
NoSparks will become famous soon enoughNoSparks will become famous soon enough
Default

Quote:
... and attached is a similar file
you might want to try that part again
Reply With Quote
  #4  
Old 01-30-2019, 10:33 AM
BCrenshaw BCrenshaw is offline Windows 7 64bit Office 2016
Novice
 
Join Date: Jun 2016
Posts: 3
BCrenshaw is on a distinguished road
Default

Quote:
Originally Posted by Pecoflyer View Post
Hi,
When posting code, please wrap it with code tags ( Edit code - select code - click the #button.)
It keeps the macro's structure and makes it easy to copy and handle.
Thank you
Sorry about that, I don't post on forums a lot. I can usually find the info I'm looking for when I search a forum.

Quote:
Originally Posted by NoSparks View Post
you might want to try that part again
I tried to upload the .csv file and didn't notice that it's not a valid format. It's there now.
Reply With Quote
  #5  
Old 01-30-2019, 03:28 PM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 656
NoSparks will become famous soon enoughNoSparks will become famous soon enough
Default

Perhaps something like this using variables to refer to the worksheets.
When you make a copy of a sheet, the copy automatically becomes the active sheet.
Code:
Sub ThreeWaySplit()

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim arr As Variant

'create copies, rename sheets
    'original sheet
    Set ws1 = ActiveSheet
    'break apart the original sheet name into an array
    arr = Split(ws1.Name, "_")
    'rename original
    ws1.Name = arr(2) & "_260"
    'first copy
    ws1.Copy After:=Sheets(1)
    ActiveSheet.Name = arr(2) & "_350"
    Set ws2 = ActiveSheet
    'second copy
    ws1.Copy After:=Sheets(2)
    ActiveSheet.Name = arr(2) & "_450"
    Set ws3 = ActiveSheet
    
'deal with original sheet
    With ws1
        .Select
        Application.Run "PERSONAL.XLS!Survey40wire"
        Application.Run "PERSONAL.XLS!Survey20WireShrinkRunFirst"
        Application.Run "PERSONAL.XLS!Survey20WirePortaitRunSecond"
    End With
'deal with first copy
    With ws2
        .Select
        Application.Run "PERSONAL.XLS!Survey40wire"
        Application.Run "PERSONAL.XLS!Survey20WireShrinkRunFirst"
        Application.Run "PERSONAL.XLS!Survey20WirePortaitRunSecond"
    End With
'deal with second copy
    With ws3
        .Select
        Application.Run "PERSONAL.XLS!Survey40wire"
        Application.Run "PERSONAL.XLS!Survey20WireShrinkRunFirst"
        Application.Run "PERSONAL.XLS!Survey20WirePortaitRunSecond"
    End With
    
End Sub
Reply With Quote
  #6  
Old 01-31-2019, 08:45 AM
BCrenshaw BCrenshaw is offline Windows 7 64bit Office 2016
Novice
 
Join Date: Jun 2016
Posts: 3
BCrenshaw is on a distinguished road
Default

Quote:
Originally Posted by NoSparks View Post
Perhaps something like this using variables to refer to the worksheets.
When you make a copy of a sheet, the copy automatically becomes the active sheet.
Ah that makes sense. It worked perfectly! Thanks NoSparks!
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro to print a value in the duplicate and triplicate copies only Marcia Excel Programming 2 09-26-2018 02:11 PM
Macro for printing 2 copies each on NCR paper for many different word docs Marq Word VBA 9 05-22-2017 08:31 PM
Looking for Help to Create a Macro (Sort) rsrasc Word VBA 5 04-16-2014 03:25 AM
Macro to conditionally create or go to worksheet Reinaldo123 Excel Programming 1 07-06-2012 07:23 AM
macro for comparing data from 3 columns and pasting into another worksheet ashukla Excel 1 06-24-2009 05:01 PM


All times are GMT -7. The time now is 05:48 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft