|
Jaka さん・りんさん
いろいろ アドバイスありがとうございます。
コードを乗せておきます。(一部)
'各シート削除(ここでコピー先のシートのデータを削除して)
For i = 1 To 数 - 1
Worksheets(Array(i)).Select
削除ID = Range("A1").Value
If 削除ID >= 1 Then
Range("A2:BP2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select
Else
End If
Next
'各項目別データ入力(抽出キーワードで抽出します。オートフィルター使用)
For i = 1 To 数 - 1
Worksheets(Array(i)).Select
項目コード = Range("A1").Value
'各シートの一番はじめのセルに項目コード(抽出キー)を仕込んでます
If 項目コード >= 1 Then
Sheets("サンプルリスト").Select
Selection.AutoFilter Field:=68, Criteria1:=項目コード
Range("B2:BP2").Select
On Error GoTo tugi
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
On Error GoTo tugi
'コピー・ペーストしてます。^^;
Worksheets(Array(i)).Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
On Error GoTo tugi
Application.CutCopyMode = False
Range("B65536").Select
Selection.End(xlUp).Select
最大行 = ActiveCell.Row
Range("a2").Select
If 最大行 = 1 Then
Else
For k = 2 To 最大行
Cells(k, 1).Value = k - 1
Next
End If
Sheets("サンプルリスト").Select
Selection.AutoFilter Field:=68
Application.CutCopyMode = False
Else
End If
tugi:
Next
----------ここまで-------------------------
おおまかに こんなマクロになってます。
|
|