ピボットテーブルの行のデータを新しいシートの次の空白にコピーする方法はありますか？

Question

私はVBAの初心者です。

Iは、シート3における濾過ピボットテーブルからデータを持っています。このデータは毎月更新され、次の利用可能な行の新しいシート（sheet8）にこの動的データ（見出しと空白を除く）をコピーして、他のピボットテーブルから他のデータもそこにコピーされる必要があります。私がこれまで試してみました何

は、このコードが意味をなさない場合、私はとても残念、私は本当にやっている見当がつかない

Sub Aggregate_Data() 
' 
' Aggregate_Data Macro 
' 
Sheet3.Activate 
LR = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row 
For i = 3 To LR 
If Sheet3.Cells(i, 1).Value <> "0" Then 
Sheet3.Rows(i).Copy 
Sheet8.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Select 
Selection.PasteSpecial xlPasteValues 
End If 
Next i 
End Sub 

です。しかし基本的に私はランタイムエラー "1004"を取得し続ける

Answer 1

Sheet8.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Selectという行でエラーが発生していると仮定すると、これはアクティブでないワークシートの範囲をSelectにしようとしたためです。あなたがする必要がある場合を除き

はSelect（およびActivate）を使用しないでください。 （詳細についてはHow to avoid using Select in Excel VBA macrosをご参照ください。）

を私はあなたのコードは以下のように書き換えることができると考えている：バリアントを使用するのは簡単です

Sub Aggregate_Data() 
' 
' Aggregate_Data Macro 
' 
    Dim i As Long 
    Dim LR As Long 
    Dim j As Long 
    Dim c As Long 
    'Find last used row in Sheet3 
    LR = Sheet3.Cells(Sheet3.Rows.Count, 1).End(xlUp).Row 
    'Find last used row in Sheet8 
    j = Sheet8.Cells(Sheet8.Rows.Count, 1).End(xlUp).Row 
    'Loop through rows on Sheet3 
    For i = 3 To LR 
     'Decide whether to copy the row or not 
     If Sheet3.Cells(i, 1).Value <> "0" Then 
      'Update pointer to the next unused row in Sheet8 
      j = j + 1 
      'Only copy used columns, to stop it thinking every cell in the 
      'destination row is "used" 
      c = Sheet3.Cells(i, Sheet3.Columns.Count).End(xlToLeft).Column 
      'Copy the values (without using Copy/Paste via the clipboard) 
      Sheet8.Rows(j).Resize(1, c).Value = Sheet3.Rows(i).Resize(1, c).Value 
     End If 
    Next i 
End Sub 

Answer 2

。

Dim vDB, vR() 
Dim n As Long, i As Long, j As Integer, c As Integer 
vDB = Sheet3.Range("a1").CurrentRegion 
c = UBound(vDB, 2) 
For i = 1 To UBound(vDB, 1) 
    If vDB(i, 1) <> 0 Then 
     n = n + 1 
     ReDim Preserve vR(1 To c, 1 To n) 
     For j = 1 To UBound(vDB, 2) 
      vR(j, n) = vDB(i, j) 
     Next j 
    End If 
Next i 
Sheet8.Range("a1").Resize(n, c) = WorksheetFunction.Transpose(vR)