Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4525 / 76732

←次へ　｜　前へ→


	【77828】Re:メモリ不足の解消の仕方

β - 16/1/6(水) 20:59 -


	引用なし

	パスワード

▼YUKI さん：

とにかく、コメントしている通りよくわかりませんが、だめもとで。
"5" と "6" の転記先がわからないので適当にしておきました。

Sub 貼り付け()
　　Dim i As Integer
　　Dim shF As Worksheet
'
'
'
　　Application.ScreenUpdating = False
　　
'　　On Error Resume Next　 '何のためのコードですか？？

　　For i = 16 To 30

　　　　With Sheets(i)
　　　　　　Set shF = Sheets(i - 15)
　　　　　　.AutoFilterMode = False
　　　　　　.Range("A1", .UsedRange).Offset(40).AutoFilter
　　　　　　'3
　　　　　　.AutoFilter.Range.AutoFilter Field:=8, Criteria1:="3"
　　　　　　If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　　　　　.AutoFilter.Range.Copy shF.Range("A35")
　　　　　　End If
　　　　　　
　　　　　　'4
　　　　　　.AutoFilter.Range.AutoFilter Field:=8, Criteria1:="4"
　　　　　　If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　　　　　.AutoFilter.Range.Copy shF.Range("Q35")
　　　　　　End If
　　　　　　'5
　　　　　　.AutoFilter.Range.AutoFilter Field:=8, Criteria1:="5"
　　　　　　If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　　　　　.AutoFilter.Range.Copy shF.Range("AG35")
　　　　　　End If
　　　　　　'6
　　　　　　.AutoFilter.Range.AutoFilter Field:=8, Criteria1:="6"
　　　　　　If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　　　　　.AutoFilter.Range.Copy shF.Range("AW35")
　　　　　　End If
　　　　　　.AutoFilterMode = False
　　　　End With
　　　　
　　　　DoEvents
　　Next
　　'
　　'
'　　Erase DynamicArray
　　Sheets(16).Select
　　Application.ScreenUpdating = True

End Sub

6 hits

▼

【77825】メモリ不足の解消の仕方 YUKI 16/1/6(水) 15:43