| 投稿日 | ： 2003/01/17(Fri) 16:09 |
| 投稿者 | ： 新入生 |
| Ｅメール | ： waves@pb3.so-net.ne.jp |
| ＵＲＬ | ： |
| タイトル | ： KKRe^2: EXCELの部分複写で別シートへ転写 |
KKさんへ
> ＶＢで行いたいのかな？ＶＢＡではなく
そうです。VBを使ってEXCELシートを参照して、別のEXCELファイルのシートに書きこみしたいのです。
> ＶＢでエクセルを扱う方法はここのページに載ってますのでそれを参照してください。
> もう知っているとは思いますけどね。
> エクセルのＶＢＡマクロを使用して行うのでしたら、
> コピーは下のようにすればできます。
> Sheets("元シート").Select
> Range("F12").Select
> Selection.Copy
> Sheets("新規シート").Select
> Range("F1").Select
> ActiveSheet.Paste
> でFを固定して（列を固定）行いたいのでしたらRangeのところで
> Range("F" & Cnt).Select
> とすれば、Cnt変数の値を変えればF列の各行を参照することができますよ。
早速やってみました。
やっぱりどこか変かな？
予め、ファイルの場所を指定する箇所(file1)を作っています。
Private Sub Command1_Click()
Label2.Caption = File1.Path & "\" & File1.FileName
Dim MyFile As String
MyFile = Dir$("c:\TEMP\work1.xls")
If Len(MyFile) > 1 Then
'ファイルを削除する
Kill "c:\TEMP\Work1.xls"
File1.Path = MyPath
File1.Refresh
End If
On Error Resume Next
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = Excel.Application
Set xlBook = xlApp.Workbooks.Open(Label1.Caption)
Set xlSheet = xlBook.Worksheets(1)
xlApp.Visible = False 'Excelを表示しない
Dim X As Integer
For X = 0 To 40
Sheets(1).Select
Range((X * 2) + 37, 2).Select
Range((X * 2) + 37, 3).Select
Range((X * 2) + 37, 24).Select
Range((X * 2) + 37, 25).Select
Range((X * 2) + 37, 26).Select
Range((X * 2) + 37, 27).Select
Range((X * 2) + 37, 28).Select
Range((X * 2) + 37, 29).Select
Range((X * 2) + 37, 30).Select
Range((X * 2) + 37, 31).Select
Range((X * 2) + 37, 32).Select
Range((X * 2) + 37, 33).Select
Range((X * 2) + 38, 33).Select
Range((X * 2) + 37, 34).Select
Range((X * 2) + 38, 34).Select
Range((X * 2) + 37, 35).Select
Selection.Copy
Sheets("新規シート").Select
Range((X * 2) + 37, 2).Select
Range((X * 2) + 37, 3).Select
Range((X * 2) + 37, 24).Select
Range((X * 2) + 37, 25).Select
Range((X * 2) + 37, 26).Select
Range((X * 2) + 37, 27).Select
Range((X * 2) + 37, 28).Select
Range((X * 2) + 37, 29).Select
Range((X * 2) + 37, 30).Select
Range((X * 2) + 37, 31).Select
Range((X * 2) + 37, 32).Select
Range((X * 2) + 37, 33).Select
Range((X * 2) + 38, 33).Select
Range((X * 2) + 37, 34).Select
Range((X * 2) + 38, 34).Select
Range((X * 2) + 37, 35).Select
ActiveSheet.Paste
Next X
xlSheet.SaveAs "c:\TEMP\Work2.xls"
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
と、こんな風に書いてます。