Excel VBA автозаполнения назначения

Question

Нужна помощь с этой строки кода:

.Range("A1:G1").AutoFill Destination:=.Range("A1:U1") 

Я пытаюсь автоматизировать сделать календарь. Код не будет компилироваться, если я изменю диапазон до любого значения, кроме A1:U1. Я хотел бы расширить диапазон до A1:AE1

По какой причине он застрял и не компилируется?

Спасибо!

Sub CreateCalendar() 
Dim lMonth As Long 
Dim strMonth As String 
Dim rStart As Range 
Dim strAddress As String 
Dim rCell As Range 
Dim lDays As Long 
Dim dDate As Date 
    'Add new sheet and format 


    ActiveWindow.DisplayGridlines = True 
     With Cells 
      .ColumnWidth = 6# 
      .Font.Size = 8 
     End With 
    'Create the Month headings 
    For lMonth = 1 To 12 
      Select Case lMonth 
        Case 1 
         strMonth = "January" 
         Set rStart = Range("A1") 
        Case 2 
         strMonth = "February" 
         Set rStart = Range("A3") 
        Case 3 
         strMonth = "March" 
         Set rStart = Range("A5") 
        Case 4 
         strMonth = "April" 
         Set rStart = Range("A7") 
        Case 5 
         strMonth = "May" 
         Set rStart = Range("A9") 
        Case 6 
         strMonth = "June" 
         Set rStart = Range("A11") 
        Case 7 
         strMonth = "July" 
         Set rStart = Range("A13") 
        Case 8 
         strMonth = "August" 
         Set rStart = Range("A15") 
        Case 9 
         strMonth = "September" 
         Set rStart = Range("A17") 
        Case 10 
         strMonth = "October" 
         Set rStart = Range("A19") 
        Case 11 
         strMonth = "November" 
         Set rStart = Range("A21") 
        Case 12 
         strMonth = "December" 
         Set rStart = Range("A23") 
      End Select 
      'Merge, AutoFill and align months 
      With rStart 
       .Value = strMonth 
       .HorizontalAlignment = xlCenter 
       .Interior.ColorIndex = 6 
       .Font.Bold = True 
        With .Range("A1:G1") 
         .Merge 
         .BorderAround LineStyle:=xlContinuous 
        End With 
       **.Range("A1:G1").AutoFill Destination:=.Range("A1:U1")** 
      End With 
    Next lMonth 
    'Pass ranges for months 
    For lMonth = 1 To 12 
     strAddress = Choose(lMonth, "A2:AE2", "A4:AE4", "A6:AE6", _ 
          "A8:AE8", "A10:AE10", "A12:AE12", _ 
          "A14:AE14", "A16:AE16", "A18:AE18", _ 
          "A20:AE20", "A22:AE22", "A24:AE24") 
     lDays = 0 
     Range(strAddress).BorderAround LineStyle:=xlContinuous 
     'Add dates to month range and format 
     For Each rCell In Range(strAddress) 
      lDays = lDays + 1 
      dDate = DateSerial(Year(Date), lMonth, lDays) 
       If Month(dDate) = lMonth Then ' It's a valid date 
        With rCell 
         .Value = dDate 
         .NumberFormat = "ddd dd" 
        End With 
       End If 
     Next rCell 
    Next lMonth 
    'add con formatting 
    With Range("A1:AE28") 
      .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=TODAY()" 
      .FormatConditions(1).Font.ColorIndex = 2 
      .FormatConditions(1).Interior.ColorIndex = 1 
    End With 
End Sub 

Answer 1

Как объясняют много раз, проблема в том, что A:G 7 столбцов,
, так что вы должны будете использовать AutoFill в диапазоне, который имеет несколько столбцов, кратное 7!

Оптимизированный код для рабочего раствора на A:AE:

Sub CreateCalendar() 
Dim wS As Worksheet 
Dim lMonth As Long 
Dim DateMidMonth As Date 
Dim LastDayOfMonth As Integer 
Dim strMonth As String 
Dim rStart As Range 
Dim Row1 As Integer 
Dim rCell As Range 

ActiveWindow.DisplayGridlines = True 

    'Add new sheet and format 
    Set wS = ThisWorkbook.Sheets.Add 

    With wS 
     With .Cells 
      .ColumnWidth = 6# 
      .Font.Size = 8 
     End With '.Cells 

     For lMonth = 1 To 12 
      DateMidMonth = CDate(lMonth & "/15/2017") 
      LastDayOfMonth = Day(Application.WorksheetFunction.EoMonth(DateMidMonth, 0)) 
      strMonth = Format(DateMidMonth, "MMMM") 
      Row1 = 1 + (lMonth - 1) * 2 

      '''Create the Month headings 
      Set rStart = .Range("A" & Row1) 
      Set rStart = .Range(rStart, rStart.Offset(0, LastDayOfMonth - 1)) 
      '''Merge, AutoFill and align months 
      With rStart 
       .Merge 
       .Value = strMonth 
       .HorizontalAlignment = xlCenter 
       .Interior.ColorIndex = 6 
       .Font.Bold = True 
       .BorderAround LineStyle:=xlContinuous 

       '''Create days 
       With .Offset(1, 0).Resize(1, .Columns.Count) 
        .BorderAround LineStyle:=xlContinuous 
        .NumberFormat = "ddd dd" 
        'Add dates to month range 
        For Each rCell In .Cells 
         rCell.Value = DateSerial(Year(Date), lMonth, rCell.Column) 
        Next rCell 
       End With '.Offset(1, 0).Resize(1, .Columns.Count) 
      End With 'rStart 
     Next lMonth 

     '''add conditional formatting 
     With .Range("A1:AE28") 
       .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=TODAY()" 
       .FormatConditions(1).Font.ColorIndex = 2 
       .FormatConditions(1).Interior.ColorIndex = 1 
     End With '.Range("A1:AE28") 
    End With 'wS 
End Sub 

выход (на французском языке):

Answer 2

Вы пробовали добавить Type к вашему Autofill?

Такие, как:

Type:=xlFillDefault 

.Range("A1:G1").AutoFill Destination:=.Range("A1:U1"),Type:=xlFillDefault 

Answer 3

попытался запустить свой код с AE1, получил эту ошибку:

Это на самом деле ошибка времени выполнения, а не ошибка компиляции. (Ошибка компиляции даже не позволяет вводить процедуру, возможно, из-за необъявленной переменной или недопустимого синтаксиса)

При заполнении объединенными ячейками вам необходимо заполнить даже кратное количеству объединенных ячеек. С A1: G1 слиты, вам необходимо объединить либо AB или AI быть кратно 7.