Yes, there's quite a lot of repeating code, so first I want to condense your code a bit, by having one macro do the repeating stuff and passing to it which cells have to be moved/copied around.
I notice that all the Forward macros have the same start copying D1 to C1, also all the reverse macros copy E1 to C1. Then the rest is sheet specific. So I summarised each macro, the first pair of cells copy, subsequent pairs cut and insert. You might confirm that I've got it right:
Sub HAW_Forward_Macro("C1","D1","B8","B5","B24","B13","B35","B29")
Sub KNT_Forward_Macro("C1","D1","B5","B7")
Sub SKT_Forward_Macro("C1","D1","B6","B8")
Sub NMW_Forward_Macro("C1","D1","B6","B8")
Sub WEM_Forward_Macro("C1","D1","B9","B5","B17","B14","B28","B22")
Sub SPK_Forward_Macro("C1","D1","B8","B5","B16","B13")
Sub HAR_Forward_Macro("C1","D1","B7","B6")
Sub KGN_Forward_Macro("C1","D1","B8","B6","B15","B13")
Sub QPK_Forward_Macro("C1","D1","B9","B5","B18","B14","B28","B23")
Sub HAW_Reverse_Macro("C1","E1","B5","B9","B13","B25","B29","B36")
Sub KNT_Reverse_Macro("C1","E1","B6","B5")
Sub SKT_Reverse_Macro("C1","E1","B7","B6")
Sub NWM_Reverse_Macro("C1","E1","B7","B6")
Sub WEM_Reverse_Macro("C1","E1","B5","B10","B14","B18","B22","B29")
Sub QPK_Reverse_Macro("C1","E1","B5","B10","B14","B19","B23","B29")
Sub SPK_Reverse_Macro("C1","E1","B5","B9","B13","B17")
Sub HAR_Reverse_Macro("C1","E1","B6","B8")
Sub KGN_Reverse_Macro("C1","E1","B6","B9","B13","B16")
Next question: You mention repeating until C1 reaches a certain date, and I also presume that the the cell C1 on all the sheets contain the same date - that is they never get out of kilter? If they were to get out of kilter, would you like the macro to bring them all back into line?
I don't think this should be too difficult to do.
--- In ExcelVBA@yahoogroups.com, Tony Davis <studiot@...> wrote:
>
> Hi all,
>
> I just wondered if there was any luck with the following, as I never had any
> posts back.
>
> kind regards
>
> Tony
>
> On 28 September 2011 20:07, Tony Davis <studiot@...> wrote:
>
> > Ok, here they are, the first macro is called from a button on the cover
> > sheet, this then runs the other macro, which I'm sure will be obvious to
> > you. As I said before, C1 contains the week ending date, D1 contains a
> > simple formula; =C1+7, and this is copied and pasted with values into C1,
> > thus increasing the week by one, the rest of the macro simple copies and
> > inserts cut cells on the various worksheets in the workbook. The date update
> > therefore is a purely passive action. What I would like to be able to do is
> > to type a week ending date into a given cell, and run a macro that would run
> > the already written macros until c1 is equal to the date that has been
> > input.
> >
> > Thanks again
> >
> > Tony
> >
> > Macro run from Cover sheet:****
> >
> > ** **
> >
> > Sub Macro28()****
> >
> > '****
> >
> > ' Macro28 Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Sheets("HAW").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!HAW_Forward_Macro"****
> >
> > Sheets("KNT").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!KNT_Forward_Macro"****
> >
> > Sheets("SKT").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!SKT_Forward_Macro"****
> >
> > Sheets("NWM").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!NMW_Forward_Macro"****
> >
> > Sheets("WEM").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!WEM_Forward_Macro"****
> >
> > Sheets("SPK").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!SPK_Forward_Macro"****
> >
> > Sheets("HAR").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!HAR_Forward_Macro"****
> >
> > Sheets("KGN").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!KGN_Forward_Macro"****
> >
> > Sheets("QPK").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!QPK_Forward_Macro"****
> >
> > Sheets("Cover").Select****
> >
> > End Sub****
> >
> > Sub Group_Roster_Reverse()****
> >
> > '****
> >
> > ' Group_Roster_Reverse Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Sheets("HAW").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!HAW_Reverse_Macro"****
> >
> > Sheets("KNT").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!KNT_Reverse_Macro"****
> >
> > Sheets("SKT").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!SKT_Reverse_Macro"****
> >
> > Sheets("NWM").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!NWM_Reverse_Macro"****
> >
> > Sheets("WEM").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!WEM_Reverse_Macro"****
> >
> > Sheets("SPK").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!SPK_Reverse_Macro"****
> >
> > Sheets("HAR").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!HAR_Reverse_Macro"****
> >
> > Sheets("KGN").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!KGN_Reverse_Macro"****
> >
> > Sheets("QPK").Select****
> >
> > Application.Run "'New WCG Roster.xlsm'!QPK_Reverse_Macro"****
> >
> > Sheets("Cover").Select****
> >
> > End Sub****
> >
> > ** **
> >
> > Sub HAW_Forward_Macro()****
> >
> > '****
> >
> > ' HAW_Forward_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("D1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B8").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B5").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B24").Select****
> >
> > Selection.Cut****
> >
> > Range("B13").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B35").Select****
> >
> > Selection.Cut****
> >
> > Range("B29").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub HAW_Reverse_Macro()****
> >
> > '****
> >
> > ' HAW_Reverse_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("E1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B5").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B9").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B13").Select****
> >
> > Selection.Cut****
> >
> > Range("B25").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B29").Select****
> >
> > Selection.Cut****
> >
> > Range("B36").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub KNT_Forward_Macro()****
> >
> > '****
> >
> > ' KNT_Forward_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("D1").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B5").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B7").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub KNT_Reverse_Macro()****
> >
> > '****
> >
> > ' KNT_Reverse_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("E1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B6").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B5").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub SKT_Forward_Macro()****
> >
> > '****
> >
> > ' SKT_Forward_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("D1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B6").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B8").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub SKT_Reverse_Macro()****
> >
> > '****
> >
> > ' SKT_Reverse_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("E1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B7").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B6").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub NMW_Forward_Macro()****
> >
> > '****
> >
> > ' NMW_Forward_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("D1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B6").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B8").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub NWM_Reverse_Macro()****
> >
> > '****
> >
> > ' NWM_Reverse_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("E1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B7").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B6").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub WEM_Forward_Macro()****
> >
> > '****
> >
> > ' WEM_Forward_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("D1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B9").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B5").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B17").Select****
> >
> > Selection.Cut****
> >
> > Range("B14").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B28").Select****
> >
> > Selection.Cut****
> >
> > Range("B22").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub WEM_Reverse_Macro()****
> >
> > '****
> >
> > ' WEM_Reverse_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("E1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B5").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B10").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B14").Select****
> >
> > Selection.Cut****
> >
> > Range("B18").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B22").Select****
> >
> > Selection.Cut****
> >
> > Range("B29").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub SPK_Forward_Macro()****
> >
> > '****
> >
> > ' SPK_Forward_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("D1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B8").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B5").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B16").Select****
> >
> > Selection.Cut****
> >
> > Range("B13").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub SPK_Reverse_Macro()****
> >
> > '****
> >
> > ' SPK_Reverse_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("E1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B5").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B9").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B13").Select****
> >
> > Selection.Cut****
> >
> > Range("B17").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub HAR_Forward_Macro()****
> >
> > '****
> >
> > ' HAR_Forward_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("D1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B7").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B6").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub HAR_Reverse_Macro()****
> >
> > '****
> >
> > ' HAR_Reverse_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("E1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B6").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B8").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub KGN_Forward_Macro()****
> >
> > '****
> >
> > ' KGN_Forward_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("D1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B8").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B6").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B15").Select****
> >
> > Selection.Cut****
> >
> > Range("B13").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub KGN_Reverse_Macro()****
> >
> > '****
> >
> > ' KGN_Reverse_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("E1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B6").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B9").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B13").Select****
> >
> > Selection.Cut****
> >
> > Range("B16").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub QPK_Forward_Macro()****
> >
> > '****
> >
> > ' QPK_Forward_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("D1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B9").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B5").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B18").Select****
> >
> > Selection.Cut****
> >
> > Range("B14").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B28").Select****
> >
> > Selection.Cut****
> >
> > Range("B23").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub****
> >
> > Sub QPK_Reverse_Macro()****
> >
> > '****
> >
> > ' QPK_Reverse_Macro Macro****
> >
> > '****
> >
> > ** **
> >
> > '****
> >
> > Range("E1").Select****
> >
> > Selection.Copy****
> >
> > Range("C1").Select****
> >
> > Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> > SkipBlanks _****
> >
> > :=False, Transpose:=False****
> >
> > Range("B5").Select****
> >
> > Application.CutCopyMode = False****
> >
> > Selection.Cut****
> >
> > Range("B10").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B14").Select****
> >
> > Selection.Cut****
> >
> > Range("B19").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > Range("B23").Select****
> >
> > Selection.Cut****
> >
> > Range("B29").Select****
> >
> > Selection.Insert Shift:=xlDown****
> >
> > End Sub
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar