简体   繁体   中英

How to define a range over multiple worksheets to use with autofill

I am trying to autofill a date series over 26 worksheets in one workbook. I have a time accounting workbook for 2014 that I want to setup for 2015. Each worksheet is one pay period with two weeks per pay period. example: Sheet1 $A$5:$A$9 week one & $A$11:$A$15 week two , Sheet2 $A$5:$A$9 week three & $A$11:$A$15 week four , etc. etc.. I want to be able to select a start date and use a series autofill command to fill in the dates for each range throughout the workbook. It just so happens that for 2015 the first date is 1/11/2015 and the last date would be 1/9/2016.

Edit

This is my current code I Would have to repeat the last 6 lines 24 times, changing the sheet referance in lines 1 and 3 each time. Is there any way to shorten this?

Sheets("pp03").Select  
myValue = InputBox("Enter Start Date")  
Range("A8").Value = myValue  
Range("A8:A14,A16:A22").Select  
Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False  
Range("D9").Select  
Sheets("pp04").Select  
Range("A8").Select  
ActiveCell.FormulaR1C1 = "=pp03!R[14]C+1"  
Range("A8:A14,A16:A22").Select  
Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay, Step:=1, Trend:=False  
Range("D9").Select

Warning: The macro below will delete the contents of any worksheets within its workbook.

The macro recorder is a great way to discover the VBA statement that matches a keyboard function but it does not produce good code. The principal reason is that it is recording your actions one by one; it does not know your objective.

Rather than ask lots of questions which would probably not make much sense if your VBA is limited, I have written a macro that creates what I would want. Try it out in a new workbook and ask questions as necessary.

If you are going to try writing macros, you must learn the basics of VBA. There are many online tutorials: search for “Excel VBA tutorial”. I prefer books. I visited my local library, borrowed a few Excel VBA Primers and then bought the one that I preferred.

Option Explicit
Sub SetDates()

  Dim DateStart As Date
  Dim DateEnd As Date
  Dim I As Long             ' Temporary integer
  Dim InxWsht As Long
  Dim RowCrnt As Long
  Dim StrStart As String
  Dim StrEnd As String
  Dim Title As String

  Title = "Fill worksheet with dates"

  StrStart = ""
  StrEnd = ""

  Do While True
    ' Loop until have acceptable start and end date

    Do While True
      ' Loop until have acceptable start date

      StrStart = InputBox("Please enter start date", Title, StrStart)
      If StrStart = "" Then
        ' User has pressed cancel
        Exit Sub
      End If
      If IsDate(StrStart) Then
        DateStart = CDate(StrStart)
        I = Weekday(DateStart, vbSunday)
        If I = vbSunday Then
          ' Have acceptable start date
          Exit Do
        End If
        Call MsgBox("Excel tells me " & StrStart & " is a " & _
                    WeekdayName(I, False, vbSunday) & _
                    " but I need a Sunday.  Please try again.", vbOKOnly, Title)
      Else
        Call MsgBox("Excel is unable to interpret " & StrStart & _
                    " as a date.  Please try again.", vbOKOnly, Title)
      End If
    Loop

    'Debug.Print StrStart & "->" & DateStart

    Do While True
      ' Loop until have acceptable end date

      StrEnd = InputBox("Start date is " & Format(DateStart, "dddd mmm, d yyyy") & _
                     "." & vbLf & "Please enter end date", Title, StrEnd)
      If StrEnd = "" Then
        ' User has pressed cancel
        Exit Sub
      End If
      If IsDate(StrEnd) Then
        DateEnd = CDate(StrEnd)
        I = Weekday(DateEnd, vbSunday)
        If I = vbSaturday Then
          ' Have acceptable end date
          Exit Do
        End If
        Call MsgBox("Excel tells me " & StrEnd & " is a " & WeekdayName(I, False, vbSunday) & _
                    " but I need a Saturday.  Please try again.", vbOKOnly, Title)
      Else
        Call MsgBox("Excel is unable to interpret " & StrEnd & _
                    " as a date.  Please try again.", vbOKOnly, Title)
      End If
    Loop

    Debug.Print StrEnd & "->" & DateEnd

    If DateStart < DateEnd Then
      Exit Do
    End If

    Call MsgBox("Start date " & StrStart & " is after end date " & _
                StrEnd & ".  Please try again.", vbOKOnly, Title)

  Loop

  ' Replace existing names of worksheets in case any existing name
  ' matches one I am able to create
  For InxWsht = 1 To Worksheets.Count
    Worksheets(InxWsht).Name = InxWsht
  Next

  InxWsht = 1

  Do While DateStart < DateEnd

    If InxWsht > Worksheets.Count Then
      ' There is no existing unused worksheet so create new
      ' one and place after any existing worksheets.
      Worksheets.Add After:=Worksheets(Worksheets.Count), Count:=1
    End If

    With Worksheets(InxWsht)

      ' Delete any existing contents
      .Cells.EntireRow.Delete

      ' Name sheet for first day
      .Name = Format(DateStart, "mmm d")

      For RowCrnt = 3 To 9
        .Cells(RowCrnt, "A").Value = Format(DateStart, "dddd mmm, d")
        DateStart = DateAdd("d", 1, DateStart)
      Next
      For RowCrnt = 11 To 17
        .Cells(RowCrnt, "A").Value = Format(DateStart, "dddd mmm, d")
        DateStart = DateAdd("d", 1, DateStart)
      Next

      .Columns("A").AutoFit

    End With

    ' Advance to next worksheet
    InxWsht = InxWsht + 1

  Loop

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM