Excelマクロ 繰り返し？の設定方法を教えて下さ

質問

BetMasterという競馬ソフトに記述されている
「TXT\2」のデータを抽出し、Sheets("出馬表集計")に貼り付け、
「TXT\1」のデータを抽出し、Sheets("結果集計")に貼り付ける
以下のようなマクロを組んでいます。1日終わるごとにTXT\2とTXT\1を作成してこの集計をしていたのですが、約1年間サボってしまい100回近く、このマクロを作動させなければならなくなりました。
そこで、TXT\1～100まで作成して、TXT\2とTXT\1の貼り付けが終わったら、「TXT\4とTXT\3」、「TXT\6とTXT\5」、「TXT\8とTXT\7」...............と「TXT\100とTXT\99」まで繰り返し抽出と貼り付けを行うようにしたいのですがどうしたらよいでしょうか。
問題は、50回繰り返すことと、2回目以降は前回終了の次の行に貼り付けるという点です。
よろしくお願い致します。

'BetMasterから出馬表データの取り込み

ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\2.", Destination:=Range("A1"))
.Name = "1."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With

'Sheets("出馬表集計")に貼り付け
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("出馬表集計").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete

'BetMasterから結果データの取り込み

ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\1.", Destination:=Range("A1"))
.Name = "1."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With

'Sheets("結果集計")に貼り付け
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("結果集計").Select
　　Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete

回答No.1

nao-y · ベストアンサー

以下のようにすればたぶんできると思います。
（検証してないので保証はできません…）

(1)ソース全体を以下のＡ・Ｂの文で挟んでください。
Ａ↓
Dim i as long
For i = 1 to 99 step 2
Ｂ↓
next i

(2)次の文を以下のように置き換えてください。
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\2.", Destination:=Range("A1"))
　↓
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\" & i+1 & ".", Destination:=Range("A1"))

(3)次の文を以下のように置き換えてください。
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\1.", Destination:=Range("A1"))
↓
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\" & i & ".", Destination:=Range("A1"))

補足

御回答ありがとうございます。早速試そうと思ったのですが、
RefreshBackgroundQuery:=Falseの部分が黄色になって停止するのです。
これは、マクロを書き換える前の状態でもおきました。
ネットで調べたのですが、InternetExplore7を導入したせい（そのため「セキュリティの警告 データ接続が無効にされました」という警告が出るようになりました）とあり、履歴を削除するなどしたのですが、マクロは作動しません。本質問とは別問題ですが、御教示いただければ幸いです。

回答No.4

nao-y

#1です。

> RefreshBackgroundQuery:=Falseの部分が黄色になって停止するのです。

停止する前にポップアップ画面が出てエラーメッセージが
表示されると思うのですが、どんなメッセージが表示されますか？

> これは、マクロを書き換える前の状態でもおきました。

ということは、このマクロは一度も動いたことがないということですか？
それともIE7導入前には動作していたのですか？

IE7の導入が影響するのはWebクエリのようなので、
関係ないと思うのですが…

お礼

誤解を招いたようで、申し訳ありません。
　もとはちゃんと作動していました(最後に使用したのは昨年8月)。
　ところが、教えていただいたマクロが作動しなかったので、念のためもとのマクロを使ってみたら作動しなかっという経緯です。
　しかし、教えていただいたように、まっさらなシートにマクロをコピペしたら動きました。
　どうもありがとうございました。

回答No.3

keithin

ご質問で掲示されたマクロがそもそも動いてませんでしたって、いったいどういうことですか。

＞本質問とは別問題です

全くその通りですね。ご自分でも判ってらっしゃるのですから、まずその点を別のご相談なり投稿してきちんとクリアしてから、このご質問に戻って「次のステップとして」解決されたらどうですか。

その際には
＞…の部分が黄色になって停止するのです。

その時に表示されるエラーのダイアログに具体的になんて書かれているか
ご利用のエクセルのバージョンは幾つを使っているのか
きちんと情報提供してください。このご相談で補足されても対応しませんので悪しからず。

また念のため、新規のまっさらのシートを１枚挿入
既存のシートを「すべて」全部まとめて漏れなくシートを削除して
から、マクロを実行してみます。

もちろん言わずもがなですが、マクロが必要としている「出馬表集計」「結果集計」の２枚のシートは、これも既存のシートは一回捨てて、まっさらのシートをそれぞれ挿入して正しい名前に変えてから行います。

＞セキュリティの警告 データ接続が無効にされました

ご利用のエクセルのバージョンが不明ですが、エクセルのオプションからセキュリティセンターで「セキュリティセンターの設定」を開始、外部コンテンツの欄ですべてのデータ接続を有効にします。

お礼

お怒りをかったようで、申し訳ありません。
　もとはちゃんと作動していました(最後に使用したのは昨年8月)。
　ところが、教えていただいたマクロが作動しなかったので、念のためもとのマクロを使ってみたら作動しなかっという経緯です。
　しかし、教えていただいたように、まっさらなシートにマクロをコピペしたら動きました。
　どうもありがとうございました。

回答No.2

keithin

dim i

ActiveWorkbook.Worksheets.Add
activesheet.name = "temp"

for i = 2 to 100 step 2
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\" & i & ".", Destination:=Range("A65536").end(xlup).offset(1))
.Name = i & "."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
next i

'Sheets("出馬表集計")に貼り付け
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("出馬表集計").Select
Range("A1").Select
ActiveSheet.Paste

range("1:1").delete shift:=xlshiftup
application.displayalerts = false
worksheets("Temp").delete
application.displayalerts = true

'BetMasterから結果データの取り込み

ActiveWorkbook.Worksheets.Add
activesheet.name = "Temp"

for i = 1 to 99 step 2
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\BetMaster\TXT\" & i & ".", Destination:=Range("A65536").end(xlup).offset(1))
.Name = i & "."
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
next i

'Sheets("結果集計")に貼り付け
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("結果集計").Select
　　Range("A1").Select
ActiveSheet.Paste

range("1:1").delete shift:=xlshiftup
application.displayalerts = false
worksheets("Temp").delete
application.displayalerts = true

補足

御回答ありがとうございます。早速試そうと思ったのですが、
RefreshBackgroundQuery:=Falseの部分が黄色になって停止するのです。
これは、マクロを書き換える前の状態でもおきました。
ネットで調べたのですが、InternetExplore7を導入したせい（そのため「セキュリティの警告 データ接続が無効にされました」という警告が出るようになりました）とあり、履歴を削除するなどしたのですが、マクロは作動しません。本質問とは別問題ですが、御教示いただければ幸いです。