| 投稿日 | ： 2004/08/10(Tue) 22:54 |
| 投稿者 | ： Renard |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re: エクセルシートの１行ずつを別ブックにコピー |
質問がよく分からないのですが、とりあえずソースの赤入れ。
> -----------------------------------------------------------------------------
> Private Sub Command1_Click()
> 'xlBook2の内容を１行ずつxlBook1にコピーする練習
> 'テスト環境：Win2000(SP4) VB6(SP6) EXCEL2000
>
> Dim xlApp As Excel.Application
> Dim xlBook1 As Excel.Workbook, xlBook2 As Excel.Workbook
> Dim xlSheet1 As Excel.Worksheet, xlSheet2 As Excel.Worksheet
>
> Dim RowPos As Long 'xlBook2のxlSheet2シートの最大行を保存
> Dim i As Long 'For-Nextのカウンター
>
> Set xlApp = CreateObject("Excel.Application")
> '新規のブック
> Set xlBook1 = xlApp.Workbooks.Add
> Set xlSheet1 = xlBook1.Worksheets(1)
> '既存のブック(ReadOnlyで開く)
> Set xlBook2 = xlApp.Workbooks.Open("C:\データ.xls",,True)
Set xlBook2 = xlApp.Workbooks.Open("C:\データ.xls",ReadOnly:=True) とした方が分かりやすい
> Set xlSheet2 = xlBook2.Worksheets("sheet1")
>
> xlApp.Visible = False
> xlApp.Application.ScreenUpdating = False 'xlApp.ScreenUpdating = True?
xlApp.ScreenUpdating = False '非表示なのに必要なのかな？（未検証）
> 'xlBook2のsheet1シートの使用されている最大行を取得(A列のセルは必ずセットされている)
> RowPos = xlSheet2.Range("A65536").End(xlUp).Row
>
> '１行ずつをコピー
> For i = 1 To RowPos
> xlApp.Application.CutCopyMode = False
> xlBook2.Activate
> xlSheet2.Activate
> xlSheet2.Rows(i & ":" & i).Select
> xlApp.Selection.Copy
> xlBook1.Activate
> xlSheet1.Activate
> xlSheet1.Range("A" & i).Select
> xlApp.ActiveSheet.Copy
> Next i
'コピーする時は、範囲を直接指定します。Activeにする必要なし。
'selectionとかも、普通使わない。
For i = 1 To RowPos
xlSheet2.Range("a" & CStr(i) & ":" & "iv" & CStr(i)).Copy _
xlSheet1.Range("a" & CStr(i))
Next i
> 'ファイルの保存と終了
> xlApp.Application.DisplayAlerts = False
xlApp.DisplayAlerts = False
> xlSheet1.SaveAs ("C:\結果.XLS") 'xlBook1.SaveAS("...") ?
xlBook1.SaveAs "C:\結果.xls"
xlBook1.Close '閉じるのを忘れずに
> xlBook2.Close (False)
'Methodの引数には普通括弧をつけない
> xlApp.Application.DisplayAlerts = True
>
> xlApp.Application.ScreenUpdating = True 'xlApp.ScreenUpdating = true ?
> xlApp.Application.Quit 'xlApp.Quit ?
'ここら辺もね。xlAppがApplicationなんだから・・・。
> Set xlSheet1 = Nothing
> Set xlSheet2 = Nothing
> Set xlBook1 = Nothing
> Set xlBook2 = Nothing
> Set xlApp = Nothing
>
> End Sub
> -----------------------------------------------------------------------------