tra********さまに伺った下記の方法で、シート1から10の最終行に手入力した情報を、別シート【合計】というシートの最終行に自動転記ができました。

Excel | Visual Basic40閲覧xmlns="http://www.w3.org/2000/svg">50

ベストアンサー

0

ThanksImg質問者からのお礼コメント

uko********さま 詳細ありがとうございました。発展のさせ方が勉強になりました。

お礼日時:4/13 21:47

その他の回答(1件)

0

Sheet11を追加し、Workbook_Openイベントで各シートの最終行をここに取得し、取得した最終行は次に開かれるまで保持しておきます。 ThisWorkbookモジュールにWorkbook_Openを作成します。 Private Sub Workbook_Open() 'シート1~10 For I = 1 To 10 On Error Resume Next J = 0 sh = "シート" & I Do DoEvents C = WorksheetFunction.CountA(Worksheets(sh).Range("A1:J1").Offset(J)) J = J + 1 Loop Until C = 0 Worksheets("Sheet11").Range("B2").Offset(I - 1) = J - 1 Next '合計 J = 0 sh = "合計" Do DoEvents C = WorksheetFunction.CountA(Worksheets(sh).Range("A1:J1").Offset(J)) J = J + 1 Loop Until C = 0 Worksheets("Sheet11").Range("B2").Offset(I - 1) = J - 1 End Sub 標準モジュールに以下のマクロを作成します。 必要の都度このマクロを実行してください。 Sub テスト() Dim LastRow As Long 転記先 = Worksheets("Sheet11").Range("B12") K = 0 For I = 1 To 10 sh = "シート" & I With sh Worksheets(sh).Activate LastRow = Worksheets("Sheet11").Range("B2").Offset(I - 1) '.Range("A" & Rows.Count).End(xlUp).Row + 1 If LastRow >= 1 Then J = -1 Do DoEvents C = WorksheetFunction.CountA(Worksheets(sh).Range("A1:J1").Offset(LastRow + J)) J = J + 1 Loop Until C = 0 If J >= 2 Then Range("A1:J1").Offset(LastRow).Resize(J - 1).Select Selection.Copy Worksheets("合計").Activate Worksheets("合計").Range("A1:J1").Offset(転記先 + K).Select Selection.PasteSpecial Paste:=xlValues K = K + J - 1 Worksheets("Sheet11").Range("C12") = 転記先 + K End If End If End With Next End Sub

画像