EntireRowを新しいシートにコピーできません - VBA - Excel - ワークシートクラスの貼り付け方法が失敗しました

Question

データの行を新しいシートにコピーしようとしています。私は代理店の名前と総売上高のリストを持っています。

リードスルーは少なくとも15個の異なるスレッドでなければなりませんが、この問題ではまだ試したことがすべてエラーに終わります。

私はただ1つのシートをコピーして次のシートにコピーしようとしています。奇妙なことは、それが実際に早く今日働いたということです！

うまくいけば、それは私が逃している単純なものです。

Set objWorksheet = ThisWorkbook.Worksheets("Control") 
    Set rng = objWorksheet.Range("A1:A" & objWorksheet.Cells(Rows.Count, "A").End(xlUp).Row) 

Sheets("Control").Select 
Range("A2").Select 

    Do Until IsEmpty(ActiveCell) 

     strAgent = ActiveCell.Value 

      For Each rngCell In rng.Cells 

       objWorksheet.Select 



        If rngCell.Value = strAgent Then 
         rngCell.EntireRow.Copy 
         Set objNewSheet = Worksheets(strAgent) 
         objNewSheet.Select 
         objNewSheet.Range("A2:G1000").ClearContents 
         Set rngNextRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row) 
         Range("A" & rngNextRow.Rows.Count + 1).Select 
         objNewSheet.Paste 


        End If 

      Next rngCell 

     ActiveCell.Offset(1, 0).Select 

    Loop 

ありがとうございます！

編集：私は明確な内容の一部を削除したときに、一見働い

コード。しかし、今度は、次のエージェントのデータとシートに移動する前に、同じデータを何度も繰り返しコピーしているように見えます（7回）。

Answer 1

あなたのコードでは「選択」が多すぎますが、これは（実際には常にそうですが）あなたが参照しているものに対する制御を失うことにつながります。

はI

• は、すべてのデータは、セル「A1」から始まる連続した列であり、少なくともによって分離を想定

  Option Explicit 
  
  Sub MySub() 
  
  Dim strAgent As String 
  Dim iFirst As Long, iLast As Long 
  
  With ThisWorkbook.Worksheets("Control") 
      With .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).CurrentRegion 'sets the range containing data, headers included 
  
       .Sort key1:=.Columns(1), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes ' sort data to have all same agents name rows grouped one after another 
  
       ' now scan the agents name column to group each first and last occurrence of every name 
       iFirst = 2 
       Do While iFirst <= .Rows.Count 
  
        strAgent = .Cells(iFirst, 1) 'set current agent name 
        iLast = iFirst 
        'skip rows until agent next agent name 
        Do While .Cells(iLast + 1, 1) = strAgent 
         iLast = iLast + 1 
        Loop 
  
        'copy the range form the first occurrence to the last one of the current agent name 
        .Rows(iFirst).Resize(iLast - iFirst + 1).Copy 
        'paste to the correspondant sheet in the first free cell of column "A" 
        With ThisWorkbook.Worksheets(strAgent) 
         .Cells(.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteAll 
        End With 
  
        iFirst = iLast + 1 'skip to the next agent name 
       Loop 
  
      End With 
  End With 
  
  
  End Sub 
  

  あなたのコードの以下「改正」を考えます可能な他のデータによって空白の列と行に表示

• 不必要にシート間のジャンプを避ける：

  多くの他の方法（「フィルタリング」一つも存在し、「ブロック」

によってコピー＆ペーストに振り分け名列を走査薬剤名

ソート10

• 実際にはよりエレガントになるでしょう）しかし、これはジャンプを開始するのに十分な直接的で効果的です