Excel2003、OSはXPを使っています。

コピー元はブックAのL2からスタートして1行ずつをコピーし
コピー先はブックBのC12からスタートして10行飛ばしでペーストする。
コピー元のL列に空白セルが来たらやめたいと考えています。

具体的には
コピー元 -> コピー先
ブックA --> ブックB
Sheet1 --> Sheet1
L2 ------> C12
L3 ------> C22
L4 ------> C32


コピー元に空白セルが来たらやめる
といったイメージです。

初めてまだ3日程度なのでお恥ずかしいのですが、
以下のようなコードを作りましたが、a=の行で
「実行時エラー'9' インデックスが有効範囲にありません。」
と出てしまいます。
Dim a As Long
Dim dc As Long
Dim dct As Long
a = Worksheets(bbk).Range("L2").End(xlDown).Rows '←実行時エラー'9'
For dc = 2 To a
For dct = 12 To dc + 10
Workbooks("ブックA.xls").Worksheets("Sheet1").Range("L" & dc).Copy _
Workbooks("ブックA.xls").).Worksheets("Sheet1").Range("C" & dct)
Next dct
Next dc

恐らく他にも悪いところはあるかと思いますが、
どうかご教授をおねがいします。

A 回答 (3件)

sub macro1()


dim i as long, j as long
i = 2
j = 12
do until worksheets("コピー元").cells(i, "L") = ""
worksheets("貼り付け先").cells(j, "C").value = worksheets("コピー元").cells(i, "L").value
i = i + 1
j = j + 10
loop
end sub


sub macro2()
dim i as long
for i = 2 to worksheets("コピー元").range("L65536").end(xlup).row
worksheets("貼り付け先").cells(10*(i - 1)+2, "C").value = worksheets("コピー元").cells(i, "L").value
next i
end sub


sub macro3()
dim c as long, h as range
c = 2
for each h in worksheets("コピー元").range("L2:L" & worksheets("コピー元").range("L65536").end(xlup).row)
c = c + 10
h.copy destination:=worksheets("貼り付け先").cells(c, "C")
next
end sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます!

同じ処理でもこんなに表現方法があるのですね。
改めて奥の深さを痛感いたしました。

この中で最も行数が少ないmacro2をいただきます。

ありがとうございました。

お礼日時:2011/04/13 22:32

こんばんは!


コピー&ペーストのコードではないのですが・・・
一例です。

↓のコード内でBook1 は「ブックA」に! Book2は「ブックB」と実際のBook名に変更してマクロを実行してみてください。

Sub test()
Dim i As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Workbooks("Book1.xls").Worksheets("sheet1") '←Book名は適宜変更
Set ws2 = Workbooks("Book2.xls").Worksheets("sheet1") '←こちらのBook名も適宜変更
ws2.Cells(12, 3) = ws1.Cells(2, 12)
For i = 3 To ws1.Cells(Rows.Count, 12).End(xlUp).Row
If ws1.Cells(i, 12) = "" Then Exit For
ws2.Cells(Rows.Count, 3).End(xlUp).Offset(10) = ws1.Cells(i, 12)
Next i
End Sub

こんな感じではどうでしょうか?m(__)m
    • good
    • 0

Worksheets(bbk).Range("L2").


の『bbk』って何でしょう?
その後の、ループ内では、
Workbooks("ブックA.xls").Worksheets("Sheet1").
と、正しくシート名を記述していますよね。

この回答への補足

ご指摘ありがとうございます。

お恥ずかしい限りですが、
bbk="ブックA.xls"ですが、直し忘れておりました。

補足日時:2011/04/13 21:47
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qフリーソフトで、WAVファイルを音楽CD-Rにコピーして、カースレテオ

フリーソフトで、WAVファイルを音楽CD-Rにコピーして、カースレテオで再生できることを目指しています。どうも、この関係のソフトは、WAVファイルを音楽CD-Rにコピーできても、PCでしか再生できないなど、がっかりさせられることが多く、まだ運命のソフトに巡り合っていません。最終的には、音楽CD-Rをカーステレオで再生できないと意味がありません。私の希望を満たすフリーソフトをご存じの方教えてください。

Aベストアンサー

DeepBurnerとか

  ”オーディオCD 作成” で検索してお好きなアプリを選択

Q【Excel VBA】シートコピー時、マクロコードはコピーしたくない

ws.copy Before:=Workbooks(File).Sheets(1)
Windows(File).Activate
Cells.Select
Selection.copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

上記コードで、シートのコピー・貼付を行っていますが、
コピー元シートのコードも引き継がれてしまいます。
引き継がれないようにコピーしたいのですが、可能でしょうか?

可不可について、
可能ならばそのやり方(コード)を教えていただけないでしょうか?

よろしくお願いします。

Aベストアンサー

こんにちは

ご質問で求められている結果に対する理解が不充分かも知れませんが、
  シート(ws)のコピーを、ブック(file)Sheet1の直前に 挿入
  作成したシートの、数式の戻り値を 値に 直す
  シートモジュールのコピーを除いたコード、、、
というお話だと理解しました。


#2さんと殆ど同じなのですが、
元のシート(ws)の書式が新しいシートに反映されるようになってます。
コメントはコピーされますが、他のShapeは残りません。
もし、Shapeまでコピーするのでしたら、別途、ご質問されるとよいと思います。

#3も禁じ手と仰っていますが、
VBAのコードそのものを書き換える方法は、
それ以外に方法がない場合の非常手段だとしても、
余程パーソナルな用途でしか考えない方が良いです。
仕事で使うことが内規違反になる可能性もあるし、
使えない環境もありますので、
私も回答には書きたくないですね。

  ◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇

Sub TEST()
Const sFile As String = "ファイル名.xls" ' ※
Dim ws As Worksheet ' ※

  Application.ScreenUpdating = False ' ※

  Set ws = ThisWorkbook.Sheets(1) ' ※

  With Workbooks(sFile).Worksheets
  With .Add(Before:=.Item(1))

    ws.Cells.Copy .Cells

    .UsedRange.Value = .UsedRange.Value

    .Activate

  Application.ScreenUpdating = True ' ※
'    MsgBox "Done" ' ※
'    .Delete ' ※
  End With
  End With
End Sub

  ◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇◇
     ' ※ の行は、便宜的な記述です。


ご質問と関係ないことを書くことを、お許し下さい。
どうしても書いておきたいので、、、

Wendy02 さん
あなたがいないと、困ります。
出来れば、考え直して頂きたいけれど、
多く学ばせて頂いた一人として、感謝しています。
ありがとう ござい ます!!

こんにちは

ご質問で求められている結果に対する理解が不充分かも知れませんが、
  シート(ws)のコピーを、ブック(file)Sheet1の直前に 挿入
  作成したシートの、数式の戻り値を 値に 直す
  シートモジュールのコピーを除いたコード、、、
というお話だと理解しました。


#2さんと殆ど同じなのですが、
元のシート(ws)の書式が新しいシートに反映されるようになってます。
コメントはコピーされますが、他のShapeは残りません。
もし、Shapeまでコピーするのでしたら、別途、ご質問されるとよ...続きを読む

QフリーソフトをCD-RやUSBメモリなどに保存して、他のPCにコピーし

フリーソフトをCD-RやUSBメモリなどに保存して、他のPCにコピーしたい(他のPCはインターネットがつながっていない環境なのでダウンロードできない・・・)のですが使用できるようになる方法を教えてください。

※やりたいこと
普段使用しているPCに入っているダウンロードしたフリーソフトを他のPCでも使いたいが、インターネットがつながっていない。

コピーしてペーストではうまくいきませんでした。
そもそもコピーペーストなんかでは使用できないのでしょうか?基本的なことからわかっていないと思いますので、どうぞ宜しくお願い致します。
環境はwinXPです。

Aベストアンサー

インストールタイプのソフトは、ダウンロードした状態のままコピーしていますか?
インストールタイプのソフトは、レジストリやProgram Filesフォルダ以外の所に
ファイルを保存しているソフトがあるので、使うパソコンでインストールしないといけません。
インターネットに繋いでいないとインストール出来ないタイプのソフトがありますが、
この場合は無理です。
インストールタイプでも、Program Filesフォルダ以外にファイルを作ったり、
レジストリを書き換えたりがなければ可能な場合がありますが、
あまり良くないのでできるだけしない方がいいです。

>コピーしてペーストではうまくいきませんでした。
とありますが、何かエラーか何か出たのでしょうか?
詳しいことが分からないので何とも言えませんが、
ソフトがそのパソコンに対応していない場合も考えられます。
ランタイムライブラリが必要な場合もあります。

ファイルを解凍してそのまま使えるタイプであれば、コピーしても基本的に可能です。

QEXCEL2003マクロについて

sendkeysで%{i}{p}{f}を実行してマクロでファイルから図の挿入をしようと思っているのですが、この時にデフォルトで「マイ ピクチャー」のフォルダーが開いてしまいます。別のフォルダー(ネットワークドライブ上のフォルダー)を開くようにマクロで設定できるでしょうか?

Aベストアンサー

>sendkeysで%{i}{p}{f}
はDialogInsertPictureダイアログを開くためのコマンドですね。

コモンダイアログのカレントフォルダ規定値は変えられないと思いますが、GetOpenFilenameを利用すれば可能です。またWindowsAPIでカレントフォルダをネットワークドライブに設定できます

以下のマクロはネットワークパスの画像ファイルをシートに挿入するサンプルですので試してみてください。GetOpenFilenameとDialogInsertPictureは選択したファイル名が表示される/されないという違いがありますが、それほど違和感はないと思います

Declare Function SetCurrentDirectory Lib "kernel32" Alias _
  "SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long

Sub Macro1()
SetCurrentDirectory ("\\abcde\Images") 'ネットワークパスを指定
res = Application.GetOpenFilename("画像 (*.jpg; *.gif; *.bmp), _
      *.jpg; *.gif; *.bmp", , "画像の挿入")
If TypeName(res) <> "Boolean" Then
  ActiveSheet.Pictures.Insert (res)
End If
End Sub

>sendkeysで%{i}{p}{f}
はDialogInsertPictureダイアログを開くためのコマンドですね。

コモンダイアログのカレントフォルダ規定値は変えられないと思いますが、GetOpenFilenameを利用すれば可能です。またWindowsAPIでカレントフォルダをネットワークドライブに設定できます

以下のマクロはネットワークパスの画像ファイルをシートに挿入するサンプルですので試してみてください。GetOpenFilenameとDialogInsertPictureは選択したファイル名が表示される/されないという違いがありますが、それほど違和感...続きを読む

QPCの文をコピーするとしゃべるフリーソフトを探しています。

PCの文をコピーするとしゃべるフリーソフトを探しています。

以前上記のようなフリーソフトを愛用していたのですが、PCが壊れて新しいのを買いました。
またダウンロードして使いたいのですが、名前を覚えていません。

特徴と言えるほどでもないんですが、水色っぽくて、パックンのような印象がありました。
コピーすると合成音声でしゃべってくれます。

また、探しているソフトでなくても、他のフリーソフトでオススメなものがありましたら教えていただけると嬉しいです。

Aベストアンサー

>水色っぽくて、パックンのような印象
【 SofTalk 】のことでしょうか?
http://www.gigafree.net/media/record/softalk.html
本家
http://cncc.hp.infoseek.co.jp/

QEXCEL2003でマクロ ファイル操作

Workbooks.Open Filenameでファイルを開くとき
フルパスを指定してやらないといけませんが、
マクロ実行ファイルと同ディレクトリにある場合は
パスはいらないのでしょうか?
別途記述(ロジック)方法があるのでしょうか?

よろしくお願いします。

Aベストアンサー

こんにちは。maruru01です。

パスを省略すると、確かカレントフォルダのパスになるんだったと思います。
カレントフォルダの初期値は、メニューの[オプション]→[全般]タブの
[カレントフォルダ]欄の値です。
カレントフォルダの変更は、ChDirステートメントで出来ます。
でも、
>マクロ実行ファイルと同ディレクトリ
なら、「ThisWorkbook.Path」で取得してファイル名と連結すればいいと思いますが。

Qデータ、音楽等をコピーできるフリーソフト

CDRなどに、データ、音楽等をコピーできるフリーソフトを探しています。
Easy CDみたいなフリーソフトありませんか?
皆さんのお勧めを教えてください。
ちなみにOSはWindows98です。
よろしくお願いします。

Aベストアンサー

バルクでもない限り、CD-R/RWのドライブに付属されていたはずですが、付属ソフトのどんな点がご不満なんでしょうか?

参考URL:http://www.forest.impress.co.jp/article/2002/12/17/cdmanipulator.html

QExcelマクロ 複数のシート検索・選択して新しいブックにコピー

何方か、回答をお願いします。
下記のマクロは、任意のフォルダに有る全てのxlsファイルのシート名が”Data”のみ
新しいブックにコピー(シート名は、元のファイル名に変更)をしていくマクロですが、
条件が下記のように変更になりました。
シート名は、DataとAppend*(*は数字で1~99)(Appendの数は毎回ばらばらでAppend
シートその物が無い場合も有ります。)を選択して新しいブックにコピー
(元のシート名の前に元のファイル名を足して新しいシート名は”ファイル名Append2”
こんな感じにしたいです。)したいのですがどの様なマクロを書けば良いのか教えて
下さい。


Sub test-xls版()

Dim myPName As String
Dim myKAKUCHOSI As String
Dim myPATHNAME As String
Dim myLName As String
Dim wb As Workbook
Dim wb_New As Workbook
Dim N As Byte
Dim ws As Worksheet
Dim myFN As String

myPName = Application.GetOpenFilename("測定データ(*.xls;*.csv),*.xls;*.csv")
If myPName = "False" Then Exit Sub

Application.ScreenUpdating = False

Set wb_New = Workbooks.Add

myKAKUCHOSI = Right(myPName, 4)
myPATHNAME = CurDir
myLName = Dir("")

N = Len(myLName)
myFN = Left(myLName, N - 4)

Do While myLName <> ""
Workbooks.OpenText Filename:=myPATHNAME & "\" & myLName, DataType:=xlDelimited, Tab:=True, Comma:=True, Space:=True

N = Len(myLName)
myFN = Left(myLName, N - 4)

Sheets("Data").Select 'csvの場合無し

Set wb = ActiveWorkbook
wb.ActiveSheet.Copy after:=wb_New.Sheets(wb_New.Worksheets.Count)

Worksheets("Data").Name = myFN 'csvの場合無し

wb.Close savechanges:=False

myLName = Dir()
Loop

Application.ScreenUpdating = True

Exit Sub

何方か、回答をお願いします。
下記のマクロは、任意のフォルダに有る全てのxlsファイルのシート名が”Data”のみ
新しいブックにコピー(シート名は、元のファイル名に変更)をしていくマクロですが、
条件が下記のように変更になりました。
シート名は、DataとAppend*(*は数字で1~99)(Appendの数は毎回ばらばらでAppend
シートその物が無い場合も有ります。)を選択して新しいブックにコピー
(元のシート名の前に元のファイル名を足して新しいシート名は”ファイル名Append2”
こんな感じにしたいです。...続きを読む

Aベストアンサー

こんばんは。Wendy02です。

>多分A1を起点に連続領域だと思いますが、

その辺りは、ある程度の余裕は考えていましたが、離れている場所には適用できません。

本来は、グラフは以下のようにするのではなく、VBAらしさを出すには、最初から、ChartObjects で作るのが正しいようなのですが、大きさが決まらないのと、今度は、散布図の場合は、片方が入らないので、以下のような変則的なマクロになっています。

他に変更した部分は、グラフの位置ですが、100行となると、下に置くわけにはいかないようなので、横に置くことにしました。また、凡例は抜くようにしました。


'-------------------------------------------------------------
'サブルーチンのみ変更
Sub MakingChartObj(NewSheet As Worksheet)
Dim Data1 As Range
Dim Data2 As Range

  Set Data1 = NewSheet.Range("B2:B100") 'X軸となるデータ範囲
  Set Data2 = NewSheet.Range("E2:E100") 'Y軸となるデータ範囲
  
  'データエラーチェック
  If Data1.Count < 2 Or WorksheetFunction.Count(Data1) < 2 Then
    Set Data1 = Nothing
    Exit Sub
    If Data2.Count < 2 Or WorksheetFunction.Count(Data2) < 2 Then
      Set Data1 = Nothing
      Set Data2 = Nothing
      Exit Sub
    End If
  End If
  Application.Goto Data1
  
  Charts.Add
  With ActiveChart
  
  .ChartType = xlXYScatter
  .SetSourceData Source:=Data2, _
   PlotBy:=xlColumns
  .Location Where:=xlLocationAsObject, Name:=NewSheet.Name
  End With
  With ActiveChart '仕切りなおし
  
   .SeriesCollection(1).XValues = "=" & NewSheet.Name & "!" & Data1.Address(1, 1, xlR1C1)
  
   .HasTitle = True
   .ChartTitle.Characters.Text = NewSheet.Name
   .HasLegend = False '凡例なし
   .Axes(xlCategory, xlPrimary).HasTitle = False
   .Axes(xlValue, xlPrimary).HasTitle = False
    
    'グラフの位置
   .Parent.Top = Data1.Cells(1).Top + 10 '上の位置
   .Parent.Left = Data2.Cells(1, 2).Left + 10 '横付けする
  End With
  Set Data1 = Nothing: Set Data2 = Nothing
End Sub

こんばんは。Wendy02です。

>多分A1を起点に連続領域だと思いますが、

その辺りは、ある程度の余裕は考えていましたが、離れている場所には適用できません。

本来は、グラフは以下のようにするのではなく、VBAらしさを出すには、最初から、ChartObjects で作るのが正しいようなのですが、大きさが決まらないのと、今度は、散布図の場合は、片方が入らないので、以下のような変則的なマクロになっています。

他に変更した部分は、グラフの位置ですが、100行となると、下に置くわけにはいかないようなの...続きを読む

QDVDのコピーのフリーソフト

DVDがコピーできるオススメ(使いやすい)のフリーソフトを教えてください。

Aベストアンサー

こちら
http://www.forest.impress.co.jp/lib/sys/hardcust/cddvdburn/cdburnerxp.html

QExcel2000マクロ_ブック名に一貫性が無くて既に開いている物の間のコピー等

何方か、回答をお願いします。
(A.xlsのAAAシート)(B.xlsのBBBシート)この2つ間のセル値をコピーしたい
のですが(共にブック名シート名に一貫性は無しで、既に開いています。)
マクロ付.xlsに下記のマクロを書いてA.xlsのAAAシートがアクティブの時にマクロを
実行してtwwにAAAシートをセット出来たのですが、Bk1にB.xlsのBBBシートをセット出来ません。
Application.Waitで止めている間にアクティブシートを変えようとしましたが駄目
Application.Dialogs(xlDialogWorkbookUnhide).Showでも駄目でした。
何方か、マクロ実行中のアクティブシート変更方法を教えて下さい。
又、この様なブック名に一貫性が無くて既に開いている物の間のコピー等はどの様に
するのか参考になる物が有れば教えて下さい。

Sub コピー()

Dim Bk1 As Worksheet
Dim tww As Worksheet

Set tww = ActiveWorkbook.Sheets(1)

'ここが分かりません

Set Bk1 = ActiveWorkbook.Sheets(1)

'-------1個目
tww.Range("D10").Value = Bk1.Range("H9").Value

Set Bk1 = Nothing: Set tww = Nothing

End Sub

何方か、回答をお願いします。
(A.xlsのAAAシート)(B.xlsのBBBシート)この2つ間のセル値をコピーしたい
のですが(共にブック名シート名に一貫性は無しで、既に開いています。)
マクロ付.xlsに下記のマクロを書いてA.xlsのAAAシートがアクティブの時にマクロを
実行してtwwにAAAシートをセット出来たのですが、Bk1にB.xlsのBBBシートをセット出来ません。
Application.Waitで止めている間にアクティブシートを変えようとしましたが駄目
Application.Dialogs(xlDialogWorkbookUnhide).Showでも駄目でし...続きを読む

Aベストアンサー

マクロ付.xlsの標準モジュールではなく、
ThisWorkbookのモジュールに
'=============================================================
Option Explicit
Private sht1 As Worksheet
Private WithEvents app As Application
Sub main()
  If ActiveSheet.Type = xlWorksheet Then
   Set app = Application
   Set sht1 = Application.ActiveSheet
   Application.StatusBar = "データをやり取りするシートをアクティブにしてください"
   End If
End Sub
'============================================================
Private Sub app_WorkbookActivate(ByVal Wb As Workbook)
  If Wb.Sheets(1).Type = xlWorksheet Then
   sht1.Cells(1, 1).Value = 1
   Wb.Sheets(1).Cells(2, 1).Value = sht1.Cells(1, 1).Value
   Application.StatusBar = False
   End If
  Set app = Nothing
End Sub

として、データ交換する最初のシートをアクティブにしてThisworkbook.mainを実行してください。

次に適当なブックをアクティブにしてください。
最初にアクティブになっていたシートのA1に1が設定され、
選択したブックの最左端シートのセルA2に
最初にアクティブになっていたシートのA1の値がコピーされます。

一例です。参考にしてください。

マクロ付.xlsの標準モジュールではなく、
ThisWorkbookのモジュールに
'=============================================================
Option Explicit
Private sht1 As Worksheet
Private WithEvents app As Application
Sub main()
  If ActiveSheet.Type = xlWorksheet Then
   Set app = Application
   Set sht1 = Application.ActiveSheet
   Application.StatusBar = "データをやり取りするシートをアクティブにしてください"
   End If
End Sub
'=========================...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報