Excel VBA質問箱 IV

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

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


18834 / 76738 ←次へ | 前へ→

【63342】データが全部消えてしまうのでうが・・・・
質問  まこっちゃん  - 09/10/28(水) 16:58 -

引用なし
パスワード
   全シートを統合するマクロがあり、それを変更しようとしてます。
このマクロはsheet1では動作確認が出来ているのですが、sheet2などでは動きません。
そこで、sheet数に関係なくマクロを動かしたいのですが、ディバックなく動くのですが今度はデータが統合できなくなりました。
”SHEET1”を(1)に変えるだけではだめなんでしょうか?
よろしくお願いします。

Sub てすてす()
Sheets.Add After:=Sheets(Sheets.Count)
  Range("A1").Select
  Dim ws As Worksheet
  Dim wsT As Worksheet
  Dim Ranges() As String, N As Long
  Set wsT = ActiveWorkbook.Worksheets("sheet1")
  For Each ws In ActiveWorkbook.Worksheets
    If Not ws Is wsT Then
      N = N + 1
      ReDim Preserve Ranges(1 To N)
      With ws
        Ranges(N) = .Range("B1", .Cells(.Rows.Count, 3).End(xlUp)) _
               .Address(, , xlR1C1, True)
      End With
    End If
  Next
  With wsT
    .UsedRange.ClearContents
    .Range("A1").Consolidate Sources:=Ranges, Function:=xlSum, _
              TopRow:=False, LeftColumn:=True
  End With
    Columns("A:B").Select
  ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("A1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("sheet1").Sort
    .SetRange Range("A1:B10000")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  Columns("A:A").Select
  Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  Range("A1").Select
End Sub

1 hits

【63342】データが全部消えてしまうのでうが・・・・ まこっちゃん 09/10/28(水) 16:58 質問
【63344】Re:データが全部消えてしまうのでうが・・... Jaka 09/10/28(水) 17:35 発言
【63346】Re:データが全部消えてしまうのでうが・・... まこっちゃん 09/10/28(水) 19:11 お礼

18834 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free