エクセルＶＢＡにて質問です。 複数のシートがあり、条件に合ったものを集計シートに転記するマクロを作りました。
エクセルＶＢＡにて質問です。 複数のシートがあり、条件に合ったものを集計シートに転記するマクロを作りました。 転記するデータごとに、シート名を特定のセルに入れたいのですが、可能でしょうか。 可能であれば、i, 15番目にシート名を入力できるようにしたいです。 以下マクロ Option Explicit Sub 未確集計() Dim sWS As Worksheet 'データシート（コピー元） Dim dWS As Worksheet '集約用シート（コピー先） Set dWS = Worksheets("未確一覧") '集約用シートの2行目以降を削除 dWS.UsedRange.Offset(1, 0).Clear '各シートの2行目以降のデータを、集約用シートの末尾にコピー For Each sWS In Worksheets If sWS.Name <> dWS.Name And sWS.Name <> "区分マスタ" And sWS.Name <> "単位マスタ" And sWS.Name <> "摘要マスタ" And sWS.Name <> "ＱＡ" And sWS.Name <> "合計" Then With sWS.UsedRange 'コピー元シートにデータが1件以上ある場合 If .Rows.Count > 1 Then .Offset(1, 0).Resize(.Rows.Count - 1).Copy _ Destination:=dWS.Cells(Rows.Count, 1). _ End(xlUp).Offset(1, 0) End If End With End If Next sWS Dim lRow As Long Dim i As Long lRow = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = lRow To 2 Step -1 If Cells(i, 13).Value = "レ" Then Range(i & ":" & i).Delete End If Next i Application.ScreenUpdating = True '集計用シートをA列で並べ替え dWS.UsedRange.Sort key1:=Range("A1"), Header:=xlYes End Sub
Visual Basic | Excel・110閲覧・25
ベストアンサー
以下の変更を試してください。未実行です。 If .Rows.Count > 1 Then .Offset(1, 0).Resize(.Rows.Count - 1).Copy _ Destination:=dWS.Cells(Rows.Count, 1). _ End(xlUp).Offset(1, 0) End If ↓ Dim ii As Long, rng As Range If .Rows.Count > 1 Then ii = .Rows.Count - 1 Set rng = dWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) .Offset(1, 8).Resize(ii).Copy Destination:=rng rng.Resize(ii).Value = sWS.Name End If
質問者からのお礼コメント
実行したらうまくいきませんでした。 表に列を追加して関数で乗り切りました。 ありがとうございました。
お礼日時：1/25 9:07
