+ Reply to Thread
Results 1 to 4 of 4

Thread: Simpify this code

  1. 06-07-2011, 04:52 PM #1
    s45yth
    s45yth is offline
    Registered User
    Join Date
    06-07-2011
    Location
    Stockport, England
    MS-Off Ver
    Excel 2003
    Posts
    12

    Simpify this code

    Basically i am copying a name from cell C4, copying it and pasting it into Cell F4.........

    Then if there is a name in Cell C5, Copy it and paste into Cell F4 again...

    Then if there is a name in Cell C6, Copy it and paste it into Cell F4 again...

    Then if there is no name in Cell C7, stop....

    But at a later date, if a name is input into C7, C8, C8 atc.. copy these names into F4 again....

    what is happening is when the name is input into Cell F4.... a data table is generated, which is then copied to a new sheet...

    Please find a simplified version of this workbook attached and the macro i recorded (upto 5 rows) below..

    Any help will be much appreciated....

    Thanks

    Scotty

    Sub Macro1()
    '
    ' Macro1 Macro
    '

    '
    Range("C4").Select
    Selection.Copy
    Range("F4").Select
    ActiveSheet.Paste
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Fees").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "I500001"
    Sheets("Fees").Select
    Range("H4:L46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("I500001").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Sheets("Fees").Select
    Range("C5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F4").Select
    ActiveSheet.Paste
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Fees").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "I500002"
    Sheets("Fees").Select
    Range("H4:L46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("I500002").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Sheets("Fees").Select
    Range("C6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F4").Select
    ActiveSheet.Paste
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Fees").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "I500003"
    Sheets("Fees").Select
    Range("H4:L46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("I500003").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Sheets("Fees").Select
    Range("C7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F4").Select
    ActiveSheet.Paste
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Fees").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "I500004"
    Sheets("Fees").Select
    Range("H4:L46").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("I500004").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Sheets("Fees").Select
    Range("C8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F4").Select
    ActiveSheet.Paste
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Fees").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "I500005"
    Sheets("Fees").Select
    Range("H4:L46").Select
    Sheets("Fees").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("I500005").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    End Sub
    Attached Files Attached Files
    Reply With Quote Reply With Quote
  2. 06-07-2011, 05:47 PM #2
    Roger Govier
    Roger Govier is offline
    Valued Forum Contributor
    Join Date
    07-17-2005
    Location
    Abergavenny, Wales, UK
    MS-Off Ver
    XL2003, XL2007, XL2010
    Posts
    474

    Re: Simpify this code

    Hi

    Replace your code with the following
    
Sub InsertSheets()
    Dim lr As Long, i As Long
    Dim ws As Worksheet
    Dim shname As String
    Set ws = Sheets("Fees")
    Application.ScreenUpdating = False
    lr = ws.Cells(Rows.Count, 3).End(xlUp).Row

    For i = 4 To lr
        If Cells(i, 3) <> "" Then
            shname = Cells(i, 3).Value
            If Not SheetExists(shname) Then
                ws.Range("F4") = shname

                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = shname
                ws.Range("H4:L46").Copy
                Sheets(shname).Range("B2").PasteSpecial Paste:=xlPasteValues
                Sheets(shname).Range("B2").PasteSpecial Paste:=xlPasteFormats
                Sheets(shname).Range("B2").PasteSpecial Paste:=xlPasteColumnWidths

                Application.CutCopyMode = False
                ws.Activate
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
    you will also need to paste in the following Function
    Function SheetExists(Sheetname As String) As Boolean
    On Error Resume Next
    SheetExists = Len(Sheets(Sheetname).Name)
    On Error GoTo 0
End Function
    --
    Regards
    Roger Govier
    Microsoft Excel MVP
    Reply With Quote Reply With Quote
  3. 06-07-2011, 06:12 PM #3
    shg
    shg is offline
    Forum Guru shg's Avatar
    Join Date
    06-20-2007
    Location
    The Great State of Texas
    MS-Off Ver
    2003, 2007, 2010
    Posts
    25,777

    Re: Simpify this code

    s45yth,

    I moved your thread out of the Access forum.

    Please take a few minutes to read the forum rules, and then edit your post to add CODE tags.

    Thanks.
    Microsoft MVP - Excel
    Entia non sunt multiplicanda sine necessitate
    Reply With Quote Reply With Quote
  4. 06-08-2011, 01:50 AM #4
    royUK
    royUK is online now
    Forum Guru, retired Admin royUK's Avatar
    Join Date
    11-18-2003
    Location
    Derbyshire,UK
    MS-Off Ver
    Xp; 2007; 2010
    Posts
    25,639

    Re: Simpify this code

    Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
    To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

    PLEASE PM WHEN YOU HAVE DONE THIS AND I WILL DELETE THIS POST
    Hope that helps.

    RoyUK
    --------
    If you are pleased with a member's answer then use the Star icon to rate it, if you are pleased enough to part with cash consider a donation to Children in Need

    For Excel Tips & Solutions, free examples and tutorials why not check out my downloads

    New members please read & follow the Forum Rules

    Remember to mark your questions Solved and rate the answer(s)
    Reply With Quote Reply With Quote
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Forum Rules


Search Engine Friendly URLs by vBSEO 3.2.0