質問です

現在、最終行はCtrl+Endで空白行に移動します
データの終わりに必ずくるようにするにはどうしたら
よいでしょうか


sheet1に1行目からn行のデータがあります
このn行のデータをF列のある条件によって
sheet3
sheet5
sheet6
に振分けています
仮にこの結果データ行が

sheet3  10行
sheet5  15行
sheet6  20行

となった場合S列まであるとして
最終行はCtrl+Endで(データの終わり)
sheet3  S列の10行目
sheet5  S列の15行目
sheet6  S列の20行目

になるようにするにはどのような方法がありますか
マクロでできればお願いします
よろしくお願いします


AからS列までに空白列はあります
列の最終はS列で変わりません
行は常に変化しますn行です
できれば保存しないで解決したいです

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2013/01/18 16:28:17
  • 終了:2013/01/18 19:27:41

ベストアンサー

id:taknt No.3

きゃづみぃ回答回数13539ベストアンサー獲得回数11982013/01/18 17:55:23

ポイント40pt

もひとつ


Sub allctlend2()
    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim i As Long
    Dim b As Long
    
    
    For i = 1 To Sheets.Count
        Sheets(i).Select
        With ActiveSheet.UsedRange
            MaxRow = .Rows(.Rows.Count).Row
            MaxCol = .Columns(.Columns.Count).Column
        End With
        For b = MaxRow To 1 Step -1
            If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then
                Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp
            Else
                Exit For
            End If
        Next b
        
        With ActiveSheet.UsedRange
            MaxRow = .Rows(.Rows.Count).Row
            MaxCol = .Columns(.Columns.Count).Column
        End With
        Sheets(i).Cells(MaxRow, MaxCol).Select
    Next
End Sub


最終行と判断された行からデータがある行までを削除。

他3件のコメントを見る
id:taknt
Sub allctlend()
    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim i As Long
    Dim b As Long
    
    
    For i = 1 To Sheets.Count
        If Sheets(i).Name = "do" Or Sheets(i).Name = "au" Or Sheets(i).Name = "sb" Then
            Sheets(i).Select
            With ActiveSheet.UsedRange
                MaxRow = .Rows(.Rows.Count).Row
                MaxCol = .Columns(.Columns.Count).Column
            End With
            For b = MaxRow To 1 Step -1
                If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then
                    Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp
                Else
                     Exit For
                End If
            Next b
            
            With ActiveSheet.UsedRange
                MaxRow = .Rows(.Rows.Count).Row
                MaxCol = .Columns(.Columns.Count).Column
            End With
            Sheets(i).Cells(MaxRow, MaxCol).Select
        End If
    Next
End Sub



シート名は
If Sheets(i).Name = "do" Or Sheets(i).Name = "au" Or Sheets(i).Name = "sb" Then
の箇所を 変更してください。

2013/01/18 18:53:51
id:inosisi4141

ありがとうございました
お手数おかけしました
うまくいきました

2013/01/18 19:26:33

その他の回答(2件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982013/01/18 17:01:25

ポイント20pt

とりあえず 最終列、行を選択するマクロを作ってみました。

Sub allctlend()
    For i = 1 To Sheets.Count
        Sheets(i).Select
        With ActiveSheet.UsedRange
            MaxRow = .Rows(.Rows.Count).Row
            MaxCol = .Columns(.Columns.Count).Column
        End With
        Sheets(i).Cells(MaxRow, MaxCol).Select
    Next
End Sub

他7件のコメントを見る
id:taknt

このマクロを変更しました。

Sub allctlend()
    For i = 1 To Sheets.Count
        s = Sheets(i).Name
        
        If s = "Sheet3" Or s = "Sheet5" Or s = "Sheet6" Then
            Sheets(i).Select
            With ActiveSheet.UsedRange
                MaxRow = .Rows(.Rows.Count).Row
                MaxCol = .Columns(.Columns.Count).Column
            End With
            Sheets(i).Cells(MaxRow, MaxCol).Select
        End If
    Next
End Sub
2013/01/18 18:15:04
id:inosisi4141

確認しました
ありがとうございました

2013/01/18 18:52:43
id:taknt No.2

きゃづみぃ回答回数13539ベストアンサー獲得回数11982013/01/18 17:47:42

ポイント40pt
Sub allctlend()
    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim i As Long
    Dim b As Long
    
    
    For i = 1 To Sheets.Count
        Sheets(i).Select
        With ActiveSheet.UsedRange
            MaxRow = .Rows(.Rows.Count).Row
            MaxCol = .Columns(.Columns.Count).Column
        End With
        For b = MaxRow To 1 Step -1
            If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then
                Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp
            End If
        Next b
        
        With ActiveSheet.UsedRange
            MaxRow = .Rows(.Rows.Count).Row
            MaxCol = .Columns(.Columns.Count).Column
        End With
        Sheets(i).Cells(MaxRow, MaxCol).Select
    Next
End Sub


こちらは どうかな?

他4件のコメントを見る
id:taknt
Sub allctlend()
    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim i As Long
    Dim b As Long
    
    
    For i = 1 To Sheets.Count
        If Sheets(i).Name = "do" Or Sheets(i).Name = "au" Or Sheets(i).Name = "sb" Then
            Sheets(i).Select
            With ActiveSheet.UsedRange
                MaxRow = .Rows(.Rows.Count).Row
                MaxCol = .Columns(.Columns.Count).Column
            End With
            For b = MaxRow To 1 Step -1
                If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then
                    Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp
                End If
            Next b
            
            With ActiveSheet.UsedRange
                MaxRow = .Rows(.Rows.Count).Row
                MaxCol = .Columns(.Columns.Count).Column
            End With
            Sheets(i).Cells(MaxRow, MaxCol).Select
        End If
    Next
End Sub
2013/01/18 18:52:18
id:inosisi4141

ありがとうございました
お手数おかけしました
うまくいきました

2013/01/18 19:26:47
id:taknt No.3

きゃづみぃ回答回数13539ベストアンサー獲得回数11982013/01/18 17:55:23ここでベストアンサー

ポイント40pt

もひとつ


Sub allctlend2()
    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim i As Long
    Dim b As Long
    
    
    For i = 1 To Sheets.Count
        Sheets(i).Select
        With ActiveSheet.UsedRange
            MaxRow = .Rows(.Rows.Count).Row
            MaxCol = .Columns(.Columns.Count).Column
        End With
        For b = MaxRow To 1 Step -1
            If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then
                Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp
            Else
                Exit For
            End If
        Next b
        
        With ActiveSheet.UsedRange
            MaxRow = .Rows(.Rows.Count).Row
            MaxCol = .Columns(.Columns.Count).Column
        End With
        Sheets(i).Cells(MaxRow, MaxCol).Select
    Next
End Sub


最終行と判断された行からデータがある行までを削除。

他3件のコメントを見る
id:taknt
Sub allctlend()
    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim i As Long
    Dim b As Long
    
    
    For i = 1 To Sheets.Count
        If Sheets(i).Name = "do" Or Sheets(i).Name = "au" Or Sheets(i).Name = "sb" Then
            Sheets(i).Select
            With ActiveSheet.UsedRange
                MaxRow = .Rows(.Rows.Count).Row
                MaxCol = .Columns(.Columns.Count).Column
            End With
            For b = MaxRow To 1 Step -1
                If Application.WorksheetFunction.CountA(ActiveSheet.Range(CStr(b) & ":" & CStr(b))) = 0 Then
                    Sheets(i).Range(CStr(b) & ":" & CStr(b)).Delete Shift:=xlUp
                Else
                     Exit For
                End If
            Next b
            
            With ActiveSheet.UsedRange
                MaxRow = .Rows(.Rows.Count).Row
                MaxCol = .Columns(.Columns.Count).Column
            End With
            Sheets(i).Cells(MaxRow, MaxCol).Select
        End If
    Next
End Sub



シート名は
If Sheets(i).Name = "do" Or Sheets(i).Name = "au" Or Sheets(i).Name = "sb" Then
の箇所を 変更してください。

2013/01/18 18:53:51
id:inosisi4141

ありがとうございました
お手数おかけしました
うまくいきました

2013/01/18 19:26:33
  • id:taknt
    Ctrl+Endでダメな理由を 教えてください。
  • id:inosisi4141
    はいマクロを実行すると空白行があれば空白行をなくすマクロがあればよいです
    ctrl+endは空白行にとびますので手動で行削除して保存する手間がいります

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません