VBA貼り付けループ中に値を貼り、ワークシートをスキップ

Question

私はほとんど私が欲しいものを持っていますが、そこまで手を伸ばしていないようです。何百ものワークシートからデータを取得しようとしています。私はA5で始まりAGに行く（行が変化している）すべてのシートの値をコピー/ペーストしたいと思います。私が以前に持っていた問題の1つは、行の残りの部分でもA列には必ずしも値がないわけではありません。列Aは私のデータ収集にとって重要ではないので、私はB5でコピー/ペーストを開始しました。

これはコピーしたいものすべてをコピーしましたが、各シートのいくつかの行は数式であり、値を貼り付ける必要があります。これは私が本当に失われたところです。

最後に、「合計」シートには「高度な」と「ピボット」という2つのシートがありません。

Sub CombineData() 
    Dim Sht As Worksheet 
    For Each Sht In ActiveWorkbook.Worksheets 
    If Sht.Name <> "Total" And Sht.Range("B5").Value <> "" Then 
    Sht.Activate 
    LastRow = Range("B65536").End(xlUp).Row 
    Range("B5", Cells(LastRow, "AG")).Copy 
    Sheets("Total").Select 
    Range("B65536").End(xlUp).Offset(1, 0).Select 
    ActiveSheet.Paste 
    Else 
    End If 
    Next Sht 


    End Sub 

すべてのヘルプは素晴らしいことだ。ここでは

は、私が使用してきたものです。ありがとうございました！このような

Answer 1

何かがあなたのために働く必要があります。

Sub CombineData() 

    Dim wb As Workbook 
    Dim ws As Worksheet 
    Dim wsTot As Worksheet 
    Dim aData As Variant 

    Set wb = ActiveWorkbook 
    Set wsTot = wb.Sheets("Total") 

    For Each ws In ActiveWorkbook.Sheets 
     If InStr(1, " " & wsTot.Name & " Advanced Pivot ", " " & ws.Name & " ", vbTextCompare) = 0 _ 
     And Len(Trim(ws.Range("B5").Value)) > 0 Then 
      aData = ws.Range("B5:AG" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row).Value 
      wsTot.Cells(wsTot.Rows.Count, "B").End(xlUp).Offset(1).Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData 
      Erase aData 
     End If 
    Next ws 

End Sub