VBAを使用して特定のワークシートに特定のワークグループにコピーする

Question

このコードを使用するには問題があります。 「Employee」の次のインスタンスが見つかるまで列Aを通過し、次に列Cで指定されたワークシートにそれらの行をコピーして、リストを元に戻します。私はかなりVBAに新しいです、誰も私を助けることができますか？

従業員情報は「Employee」という単語の2つのインスタンスの間にあるため、これをトリガーとして設定し、行の開始点と終了点を設定しようとしました。

ご迷惑をおかけして申し訳ございませんが、私はむしろ新しいです。コードで私の目標は、1つのシート（ "Regs"）からC列の範囲内のセルで指定された別のシートに範囲をコピーすることです。この範囲は、高さが5〜16行のいずれかで、それぞれが2で挟まれています列Aの「従業員」のインスタンス：「従業員：###### - Lname、Fname」、「従業員合計」のインスタンス私の具体的な問題は、各範囲をコピーした後に可変量をステップするようにループを設定することです（変数の量は、以前にコピーされた範囲の行数です）。

私は解決策を見つけましたが、私はそれを下に置いていますが、私はそれがよりうまくいくと確信しています。

Sub HourAllocationsRegs() 

    Dim StartRow As Integer 
    Dim EndRow As Integer 
    Dim lngLastRow As Long 
    Dim strMyValue As String 

    strMyValue = "Employee" 'Value to search for, change as required. 
    Sheets("Regs").Select 
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Search Column A, change as required. 

    For i = 2 To lRow Step K - i 'Starts on Row 7 and will jump to the next group according to row of next value 
     StartRow = i 
     For K = i + 1 To 100 Step 1 
      If InStr(1, (Range("A" & i + 1).Value), strMyValue) > 0 Then 
       EndRow = K 
       Exit For 
      End If 
     Next 
     Rows(Str(StartRow) & ":" & Str(EndRow)).Select 
     Selection.Copy 
     Sheets(Range("C" & Str(StartRow + 2)).Text).Select 
     Range("A1048576").End(xlUp).Offset(1, 0).Select 
     ActiveSheet.Paste 
    Next 

End Sub 

Answer 1

ワークシートを選択せず​​に行う方法は次のとおりです。

Sub HourAllocationsRegs2() 
    Dim lngLastRow As Long, x As Long, x1 As Long 

    Dim SheetName As String, strMyValue As String 
    strMyValue = "Employee"       'Value to search for, change as required. 
    With Worksheets("Regs") 
     lngLastRow = .Range("A" & .Rows.Count).End(xlUp).Row 
     For x = 2 To lngLastRow 
      If InStr(1, .Cells(x, 1), strMyValue) > 0 Then 
       For x1 = x + 1 To lngLastRow 
        If x1 = lngLastRow Or InStr(1, .Cells(x1 + 1, 1), strMyValue) > 0 Then 
         SheetName = .Cells(x + 1, 1).Value 
         .Rows(x & ":" & x1).Copy Destination:=Worksheets(SheetName).Range("A" & .Rows.Count).End(xlUp).Offset(1) 
         x = x1 
         Exit For 
        End If 
       Next 
      End If 
     Next 
    End With 
End Sub 

Answer 2

まず、Findを使用することです。 findに問題がある場合は、次のコードを使用できます。

Dim i, j, k, LR as Integer 
j=0 
k=0 
LR = Cells(Rows.Count, 1).End(xlUp).Row 
For i = 2 to LR 
    If Cells(i,1).Value="Employee" Then 
     If k=0 And j=0 Then 
      k=Cells(i,1).Row 
     Else 
      If j=0 Then 
       j=Cells(i,1).Row 
      Else 
      End If 
     End If 
    Else 
    End If 
Next i 
DestinationRange.Value = Range(Rows(k+1),Rows(j-1)).Value 'Destination range is where you want to be; not defined 

Answer 3

それ以上の時間を費やして解決策を見つけました。あなたがそれをより良くできるかどうか編集してください！

Sub HourAllocationsRegs() 

Dim strStartRow As String 
Dim strEndRow As String 
Dim strRefRow As String 
Dim lngLastRow As Long 
Dim strMyValue As String 

Application.ScreenUpdating = False 

strMyValue = "Employee Totals" 'Value to search for, change as required. 
Sheets("Regs").Select 
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Search Column A, change as required. 

For i = 7 To lngLastRow Step (K - lngStartRow + 1) 'Starts on Row 7 and will jump to the next group according to row of next value 
    strStartRow = (i + K - lngStartRow) 
    strRefRow = (i + K - lngStartRow + 3) 
    For K = Val(strStartRow) To lngLastRow Step 1 
     If InStr(1, (Range("A" & K).Value), strMyValue) > 0 Then 
      strEndRow = K 
      Rows(strStartRow & ":" & strEndRow).Select 
      Selection.Copy 
      Sheets(Range("C" & strRefRow).Text).Select 
      Range("A1048576").End(xlUp).Offset(1, 0).Select 
      ActiveSheet.Paste 
      Application.CutCopyMode = False 
      Sheets("Regs").Select 
      lngStartRow = i 
      Exit For 
     End If 
    Next 
Next 

End Sub