返回列表 上一主題 發帖

[發問] 重複列數移動至新工作表

  1. Sub TEST()
  2. Dim xS As Worksheet, SHN$, i&, j%
  3. With Sheets("總表")
  4.   For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row Step 12
  5.    j = (i - 1) / 4 + 1
  6.    SHN = j & "~" & j + 2 & "組"
  7.    On Error Resume Next: Set xS = Sheets(SHN): On Error GoTo 0
  8.    If xS Is Nothing Then Worksheets.Add(after:=Sheets(Sheets.Count)).Name = SHN
  9.    Set xS = Sheets(SHN)
  10.  
  11.    .Cells(i, 1).Resize(12, 4).Copy xS.[A1]
  12.    For j = 1 To 4: xS.Cells(1, j).ColumnWidth = .Cells(1, j).ColumnWidth: Next
  13.    For j = 1 To 12: xS.Cells(j, 1).RowHeight = .Cells(j, 1).RowHeight: Next
  14.    Set xS = Nothing
  15.   Next i
  16. End With
  17. End Sub
複製代碼
================================
On Error Resume Next
Set xS = Sheets(SHN)
On Error GoTo 0
略過錯誤指令只針對 Set xS = Sheets(SHN),
過後還是要恢復偵錯功能,否則遇錯誤無法檢知,對資料的正確性有風險!!!

TOP

        靜思自在 : 有心就有福,有願就有力,自造福田,自得福緣。
返回列表 上一主題