VBA：将数据段复制到另一张纸上-Java 学习之路

首先，我是VBA的新手请温柔 . 我的代码位于图片下方，此代码必须读取 Department # 并复制 Department # 下的所有内容，直到下一个 Department # 接近并将复制的数据粘贴到该部门的指定工作表中 .

在该图中， Department 73 从（A1：H1）开始，结束于（A30：H30） . 下一部门从第31行开始，到第37行结束 . 事情是，有80个部门，每个部门都有自己的工作表 . 这个excel文件以这种方式格式化 . 是否可以编写一个可以通过读取帐户来定位Departments＃的宏，并复制它上面的三行和 ONLY 其自身的值，直到它到达下一个部门成员并将这些值粘贴到指定的工作表中 . 像部门3，部门5 .

enter image description here
这段代码只是头脑风暴，我不知道如何对此进行编码...如果您有经验，请提供帮助 .

Sub copyingdata()

   Dim sec1 As Long

   Dim Counter As Integer
   Dim MyString As String

   MyString = "Department 63"
   For i = 1 To Len(MyString)

   sec1 = WorksheetFunction.Match("Department 60", .Columns("A"), 0)
   sec1.Resize(i).Select

   Selection
   Sheets("Sheet1").Selection.Copy Destination:=Sheets("Amanda").Range("A1")
   Sheets("Sheet1").Selection.Copy
   Sheets("Amanda").Activate
   Range("A1").Select
   ActiveSheet.Paste
   Application.CutCopyMode = False
   End Sub

1 回答

根据我们的聊天，我相信以下代码会将您的数据拆分为您已设置的工作表：

Sub AllocateDepartmentData()
    Dim prevRow As Long
    Dim deptRow As Long
    Dim deptNum As Variant
    Dim destSheet As String
    Dim destRow As Long
    prevRow = 0
    'Find the end of the first section
    deptRow = Range("A:A").Find(What:="Department", LookIn:=xlValues, LookAt:=xlPart).Row
    Do While deptRow > prevRow
        'Parse the cell containing the department number/name to get just the number
        deptNum = Cells(deptRow, 1).Value
        deptNum = Mid(deptNum, InStr(deptNum, " ") + 1)
        deptNum = CInt(Left(deptNum, InStr(deptNum & " ", " ") - 1))
        'Based on the department number, determine the destination sheet
        Select Case deptNum
            'One "Case" statement should be set for each destination sheet name
            Case 1, 2, 60, 61, 63
                destSheet = "Amanda"
            'Add more "Case" statements for each sheet
            Case 73, 74
                destSheet = "Shannon"
            'And finally catch any departments that haven't been allocated to a sheet
            Case Else
                MsgBox "Department " & deptNum & " has not been allocated to anyone!"
                End
        End Select
        With Worksheets(destSheet)
            'Work out which row to copy to
            destRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            'destRow will be 2 if the sheet was currently empty, so adjust to be 1 instead
            If destRow = 2 Then destRow = 1
            'Copy everything from the end of the previous section to the end of this section
            Rows((prevRow + 1) & ":" & deptRow).Copy Destination:=.Range("A" & destRow)
        End With
        'Set up for next section
        prevRow = deptRow
        deptRow = Range("A:A").FindNext(Cells(deptRow, "A")).Row
        'The loop will stop once the newly found "Department" is on a row before the last processed section
    Loop
End Sub

回复于 2024-05-09T11:26:44+08:00

VBA：将数据段复制到另一张纸上

1 回答

相关问题