投稿時間:2003/01/17(Fri) 16:09 投稿者名:新入生
Eメール:waves@pb3.so-net.ne.jp
URL :
タイトル:KKRe^2: EXCELの部分複写で別シートへ転写
KKさんへ
> VBで行いたいのかな?VBAではなく そうです。VBを使ってEXCELシートを参照して、別のEXCELファイルのシートに書きこみしたいのです。
> VBでエクセルを扱う方法はここのページに載ってますのでそれを参照してください。 > もう知っているとは思いますけどね。 > エクセルのVBAマクロを使用して行うのでしたら、 > コピーは下のようにすればできます。 > 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
と、こんな風に書いてます。
|