如何保留标题并消除此脚本中的偏移量?

时间:2018-10-01 18:44:27

标签: vba excel-vba

我有一个脚本,该脚本通过“ <>”传输数据,以便将组中的管理者分开。

它有效,但我想重新调整用途。我替换了某些名称和范围,但卡在

dest(a,j) = data(I,k)

行。当移至下一个管理人员群体时,它也在调整大小(清除内容)。它曾经读为

dest.offset(a,j) = data (I,k)

但是我没有使用偏移量,我只希望它粘贴正常值。

dest.resize(,columns.count - dest.column).entirecolumn.clearcontents

我想保留标题,但我不想在其中保留以前的员工人数数据,只需标题,以便数组可以粘贴到新内容中。

我该如何进行这两项编辑并在此脚本中实现它们:

Option Explicit

Sub MainOne()
  Dim Wb As Workbook
  Dim Data, Last
  Dim i As Long, j As Long, k As Long, a As Long
  Dim Dest As Range

  'Refer to the template
  Set Wb = Workbooks("DummyTemplateBlankWorksheet.xlsm")
  'Refer to the destination cell
  Set Dest = Wb.Sheets("Sheet1").Range("a2")
  'Read in all data
  With ThisWorkbook.Sheets("Data")
    Data = .Range("Y2", .Range("A" & Rows.Count).End(xlUp))
  End With
  Wb.Activate
  Application.ScreenUpdating = False

  'Process the data
  For i = 1 To UBound(Data)
    'Manager changes?
    If Data(i, 1) <> Last Then
      'Skip the first
      If i > 1 Then
        'Scroll into the view
        Dest.Select
        'Save a copy
        Wb.SaveCopyAs ThisWorkbook.Path & Application.PathSeparator & _
          ValidFileName(Last & "_Assessment.xlsx")
      End If
      'Clear the employees
      Dest.Resize(, Columns.Count - Dest.Column).EntireColumn.ClearContents
      'Remember this manager
      Last = Data(i, 1)
      'Start the next round
      j = 0
    End If
    'Write the employee data into the template
    a = 0
    For k = 2 To UBound(Data, 2)
      Dest.Offset(a, j) = Data(i, k)
      a = a + 1
    Next
    'Copy the numberformats if we exceed column E

    'Next column
    j = j + 1
  Next
End Sub

0 个答案:

没有答案