Simpify this code

**s45yth** · 06-07-2011, 04:52 PM

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

**Roger Govier** · 06-07-2011, 05:47 PM

Hi

Replace your code with the following

Please Login or Register  to view this content.

you will also need to paste in the following Function

Please Login or Register  to view this content.

**shg** · 06-07-2011, 06:12 PM

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.

**royUK** · 06-08-2011, 01:50 AM

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