VBA : 데이터 시트를 다른 시트로 복사

Question

우선, 나는 VBA를 가진 초보자입니다. 내 코드가 그림 아래에 있으며이 코드는 Department #을 읽고 Department # 아래에 오는 모든 내용을 복사하여 다음 Department #이 복사하여 해당 부서의 지정된 시트에 복사 한 데이터를 붙여 넣습니다.가 끝나는 (A30 : H30) : (H1 A1)이 그림에

, Department 73 시작한다. 다음 부서는 31 행에서 시작하여 37 행에서 끝납니다. 80 개 부서가 있고 각자 자신의 시트가 있습니다. 이 파일은 Excel 형식으로 제공됩니다. 계정을 읽고 세 줄을 복사하여 만 자체 부서 값 에 도달 할 때까지 고유 한 값을 할당 된 시트에 붙여 넣을 수 있으므로 부서 번호를 찾을 수있는 매크로를 작성할 수 있습니까? 부서 3, 부서 5와 같습니다.

이 코드는 단지 브레인 스토밍입니다.이 코드를 작성하는 방법을 정확히 알지 못합니다 ... 경험이 있으면 도움을주십시오.

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 

Answer 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