因此,我一直在努力使此电子表格正常运行。基本上,我是按Techs名称(H列)对数据进行预排序的。然后,我想将每个分配的设备及其名称复制到各个工作表中。我似乎无法弄清楚复制行的范围语法。我有2个柜台在营业。计数器以继续比较每一行,而TechCount可以移动我的复印范围的起点。我是一个新手,所以我敢肯定有一种更有效的方法。
Example: Data Set
'Create individual Worksheets for Techs with Primary & Secondary Assignments
Dim ws As Worksheet
Dim TechNm As String
Dim wsNM As String
Dim counter As Integer
Dim TechCount As Integer
ActiveWorkbook.Worksheets("DATA SET").Select
TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Value
counter = 0
TechCount = 0
Do
If IsEmpty(Range("H2").Value) = True Then
Exit Do
End If
If TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then
counter = counter + 1
ElseIf TechNm <> ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter + 1, 0).Value Then
'Create Worksheet with Tech Name
wsNM = ActiveWorkbook.Sheets("DATA SET").Range("H2")
Set ws = ActiveWorkbook.Sheets.Add(after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
ws.Name = wsNM
'Copy Header Row to new worksheet
ActiveWorkbook.Sheets("DATA SET").Rows(1).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A1")
'Move Tech assignments to new sheet
**ActiveWorkbook.Sheets("DATA SET").Range("A" & TechCount & ":A" & counter).EntireRow.Copy ActiveWorkbook.Sheets(wsNM).Range("A2")**
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.EntireColumn.AutoFit
End With
Rows(1).EntireColumn.AutoFilter
Range("A2").Select
Application.CutCopyMode = False
'Change Do Loop Parameters
ActiveWorkbook.Worksheets("DATA SET").Select
counter = counter + 1
TechCount = counter
TechNm = ActiveWorkbook.Sheets("DATA SET").Range("H2").Offset(counter, 0).Value
End If
Loop
ActiveWorkbook.Worksheets("TECH ASSIGNMENTS").Select
End Sub