[[20180305081700]]　『特定シート名前まで作業したい』（あすか）　ページの最後に飛ぶ

『特定シート名前まで作業したい』（あすか）

お世話になります
教えていただけないでしょうか
下記のマクロはシート一枚目の作業です続いて
2枚目以降は　マクロ　”フォルダー取得”　を除いた作業を行いたいです
その時　シート名　資料という名前の前まで
行いたいです　　
お手数おかけしますが　上記の作業させるには
どのように書けばいいのでしょうか
よろしくお願いします

Private Sub CommandButton1_Click()

フォルダー取得

Dim TargetPath As String
Dim myFname As String, i As Long, l As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False
l = "=LEFT(A2,14)"

  i = 2

   TargetPath = Me.TextBox1.Value

       ThisWorkbook.ActiveSheet.Copy before:=Workbooks.Add.Sheets(1)

           TargetPath = Me.TextBox1.Value

           ActiveSheet.SaveAs TargetPath & "\" & _
          Left(Range("a2").Value, 14) & ".csv", _
           FileFormat:=xlCSV, CreateBackup:=False                  
   ActiveWorkbook.Close SaveChanges:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox UserForm4.TextBox1.Text & vbCrLf & ActiveSheet.Name & vbCrLf & "作成しました"
End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

書いてる所で汚いのですが下記のようにすると

ww.Active　ここでエラーが出てしまいます
何処がいけないのでしょうか？？？

Private Sub CommandButton2_Click()

Dim ww As Worksheet
Application.DisplayAlerts = False
For Each ww In ActiveWorkbook.Sheets
If ww.Name <> "RA_RACE" And ww.Name <> "CodeTable" And ww.Name <> "SE_RACE" Then
ww.Active

Dim TargetPath As String
Dim myFname As String, i As Long, l As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False
l = "=LEFT(A2,14)"

  i = 2

   TargetPath = Me.TextBox1.Value

       ThisWorkbook.ActiveSheet.Copy before:=Workbooks.Add.Sheets(1)

           TargetPath = Me.TextBox1.Value

           ActiveSheet.SaveAs TargetPath & "\" & _
          Left(Range("a2").Value, 14) & ".csv", _
           FileFormat:=xlCSV, CreateBackup:=False                  'AX列
   ActiveWorkbook.Close SaveChanges:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox UserForm4.TextBox1.Text & vbCrLf & ActiveSheet.Name & vbCrLf & "作成しました"

Next ww
End Sub
（あすか） 2018/03/05(月) 09:17

If ww.Name <> "RA_RACE" And ww.Name <> "CodeTable" And ww.Name <> "SE_RACE"
この部分別なファイルから持ってきたため　別名前が入ります
修正するの忘れてました
（あすか） 2018/03/05(月) 09:19

Activate

（隠居じーさん） 2018/03/05(月) 09:21

隠居じーさん　　様
有難う御座います
無事出来ました
（あすか） 2018/03/05(月) 09:27

Activateの件は、隠居じーさんさんの仰るとおりですが、そもそものコードをみるとシートやブックをわざわざアクティブにする必要がないとおもいます。余計なお世話かもしれませんが、その点を踏まえてちょっと修正してみました。興味があれば研究してみてください。
※１：個人的にActive○〇に対する操作というのが嫌いなので、そこも修正してあります。
※２：テストデータ用意するのがめんどくさかったので、コンパイルエラーにならないことくらいしかチェックしてないです。

Private Sub CommandButton2_Click()
'==変数の宣言とか

    Dim ww As Worksheet
    Dim TargetPath As String
'    Dim myFname As String, i As Long, l As Variant
    Dim i As Long, n As Long

'==処理

    Application.ScreenUpdating = False '画面更新停止
    Application.DisplayAlerts = False '確認メッセージの表示を停止

    '「資料」シートの存在をチェックして、あればその1つ前のシートのINDEX番号を変数に格納
    For Each ww In ThisWorkbook.Worksheets
        If ww.Name = "資料" Then
            i = ww.Index - 1
            Exit For
        End If
    Next ww

    'エラー処理
    If i = 0 Then
        MsgBox "「資料」シートが存在しない、または、最初のシートであるため処理できません"
        Exit Sub
    End If

    '1番目のシートから「資料」シートの前までを処理
    For n = 1 To i
        '１番目のシートを処理する時だけフォルダ取得を実施
        If n = 1 Then
            '【フォルダ取得】
            TargetPath = Me.TextBox1.Value
        End If

        '新規ブックを用意
        With Workbooks.Add

            'n番目のシートを、新規ブックの１シート目にコピー挿入
            ThisWorkbook.Worksheets(n).Copy before:=.Sheets(1)

            '新規ブックをCSV形式で保存
            .SaveAs _
                Filename:=TargetPath & "\" & Left(Range("A2").Value, 14) & "_" & n & ".csv", _
                FileFormat:=xlCSV, CreateBackup:=False

            '新規ブックを閉じる（CSV形式で保存済みなのでエクセルブックとしては保存せず閉じる）
            .Close SaveChanges:=True

        End With
    Next n

    Application.ScreenUpdating = True '画面更新再開
    Application.DisplayAlerts = True '確認メッセージの表示を再開
End Sub
（もこな２） 2018/03/05(月) 11:19

もこな２様
有難う御座います

凄いですね
きれいでいいです
（あすか） 2018/03/05(月) 11:45

コメント返信：

[ 一覧(最新更新順) ]

[[20180305081700]] 『特定シート名前まで作業したい』（あすか） ページの最後に飛ぶ

[[20180305081700]]　『特定シート名前まで作業したい』（あすか）　ページの最後に飛ぶ