|
▼ayu さん:
たとえば以下で試してみてください。
どうしても、遅い!! ということなら別途の方法を考えましょう。
Sub Sample()
Dim shF As Worksheet
Dim shT As Worksheet
Dim x As Long
Dim c As Range
Application.ScreenUpdating = False '処理中の画面の動きを隠す
Set shF = Workbooks.Open(ThisWorkbook.Path & "\元のブック.xlsx").Sheets("該当のシート名")
Set shT = ThisWorkbook.Sheets("転記先のシート名")
shT.Cells.ClearContents '転記前にクリア
x = 1 '転記開始行
For Each c In shF.Range("A9:F9") '元ブックの合計行のセルの取り出し
If c.Value > 0 Then ' 0 超なら
shT.Cells(x, "A").Value = c.EntireColumn.Cells(2).Value '項目名
shT.Cells(x, "B").Value = c.Value '合計数
x = x + 1 '次の転記行
End If
Next
shF.Parent.Close False '元ブックを閉じる
End Sub
|
|