(B1:B28)を選択しD2に貼り付け(値・行列入れ替え)
(B29:B56)を選択しD3に貼り付け(値・行列入れ替え)
(B57:B84)を選択しD4に貼り付け(値・行列入れ替え)
:
:
:

といった感じに28個セルを選択し順順に貼り付けていく作業を行っているのですが330回くらい繰り返すのであまりに大変なのでマクロを作成しました。やはり途中で操作ミスなどありましたがなんとか記録できました。

しかしこれはVBAで作成すればもっとスマートにできるかな?と思い質問させて頂きます。
どなたかわかる方いれば宜しくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (6件)

こんな感じ?



Sub Transpose28()

Dim i As Integer
Application.ScreenUpdating = False
For i = 1 To 330
Cells(i * 28 - 27, 2).Resize(28).Select
Selection.Copy
Cells(i + 1, 4).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=True
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
    • good
    • 6
この回答へのお礼

ありがとうございます。
おかげでかなり楽な作業になりました。
またよろしくお願いします。

お礼日時:2001/12/12 11:02

セルD1に


 =INDIRECT("B"&(ROW()-1)*28+COLUMN()-3)
を入力して、必要なだけコピーしてもできますね。


皆さんと同じようなマクロですが、Forループから数値をとってみました。
最終行をシートの一番下から探しています。

Sub DataCopy()
  Dim rw As Long '行カウンタ

  Application.ScreenUpdating = False '画面更新を止める

  'B列の入力されている最後まで、B1から28個飛びで処理していく
  For rw = 1 To Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row Step 28
    '行方向のコピー。28個
    Range(Cells(rw, 2), Cells(rw + 28 - 1, 2)).Copy
    '列方向に貼り付け。コピー開始行から貼り付け先の行番号を計算。列はDなので4
    Cells((rw - 1) \ 28 + 1, 4).PasteSpecial Paste:=xlValues, Transpose:=True
  Next

  Application.ScreenUpdating = True '画面更新
End Sub
    • good
    • 1
この回答へのお礼

D1のセルに入力するだけでもできるとは・・・・
まだまだ色々勉強していきたいとおもいます。
ありがとうございます。

お礼日時:2001/12/12 11:05

先に回答されている方と同じですが、極く短く


Private Sub CommandButton1_Click()
j=2
for i=1 to 200 step 8 ’200は仮の例
Range(Cells(i, 1), Cells(i+8, 1)).Copy 'A列について
Cells(j, 2).PasteSpecial Paste:=xlValue, Transpose:=True
j=j+1 ’B2からよこに、B3からよこに、B4から横に・・・値だけコピー
next i
End Sub
テストをし易くするため28個を8個の縦の数値を横にする例に変えました。
    • good
    • 0
この回答へのお礼

ありがとうございます。
こんなに短くできるんですね。。
もっと勉強したいとおもいます。
ありがとうございました。

お礼日時:2001/12/12 11:03

再び。

すみません、補足を読んでいませんでした。
Paste:=xlAll は Paste:=xlValues に替えて下さい。
    • good
    • 1

常に28行コピーするのであればループさせればよいだけだと思います。



loopとかnextとかでヘルプを参照してください。
    • good
    • 1

意味不明なのですが・・・



とりあえず、この書き込みを見た人の多くは
Step 27
という文字がうかんでいると思うのですが、処理の内容がよくわからないために、回答をできないでいるのだと思います。

複数行のコピーを繰り返してますが、貼り付け先は[D2/D3/D4]と範囲を持っていません。
これでは直前に貼り付けた値が、常に上書きされるはずです。
また
>(値・行列入れ替え)
の部分は、全くどのような法則で行われているのか全く記述されておりません。

質問エリアは800文字しか記入できませんが、補足欄には文字制限が無いので、できたら記録したマクロコードを貼り付けてもらえませんか?

その方がみんなもわかりやすいと思います。

この回答への補足

申し訳ございません。説明不足でした、補足させていただきます。
B1:B28を選択しコピーします。

D1を右クリックし「形式を指定して貼り付け」を選び「値」と「行列を入れ替える」を選択し(演算の項目はしないのままです)貼り付けを行います。

行列を入れ替えて貼り付けているので
<B1:B28→D1:AE1>に貼り付けとことになります。

下記がコードになります
Range("B1:B28").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Range("B29:B56").Select
Application.CutCopyMode = False
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True


Range("B57:B84").Select
Application.CutCopyMode = False
Selection.Copy
Range("D3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

お願いします

補足日時:2001/12/07 17:20
    • good
    • 0

このQ&Aに関連する人気のQ&A

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

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

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

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

QVBA コピーを有効行までループをする方法

VBAをはじめたばかりの初心者です。
業務でマクロ処理をするよう言われましたが、苦戦しております。
なんとか今週中にしあげなければならない状況で、ご存知の方がいらっしゃれば助けていただければと思います。

1行目・・・項目が記載されています。
2行目以降・・・A列~G列・I~K列に住所などの情報があり、H列とL列にはとある計算式をいれています。
件数は約500件(500行)程度で、毎回変更します。

H2とL2に計算式を入れて、
セルH2の値をH3にコピー、セルL2の値をL3にコピーするマクロが自動記録で次のようにできました。
Range("H2").Select
Selection.Copy
Range("H3").Select
ActiveSheet.Paste
Range("L2").Select
Application.CutCopyMode = False
Selection.Copy
Range("L3").Select
ActiveSheet.Paste

これを、H4・L4、H5・L5・・・・と繰り返してコピーをしていき、データがなくなったらループを修了するという記述をしたいのですが、わかりません。
いろいろネットで探してみたのですが、データ数を指定するやり方(?)ではなく、「Do~Loop」を使った方法でやりたいと思っております。

どなたか教えていただけませんでしょうか。
宜しくお願いいたします。

VBAをはじめたばかりの初心者です。
業務でマクロ処理をするよう言われましたが、苦戦しております。
なんとか今週中にしあげなければならない状況で、ご存知の方がいらっしゃれば助けていただければと思います。

1行目・・・項目が記載されています。
2行目以降・・・A列~G列・I~K列に住所などの情報があり、H列とL列にはとある計算式をいれています。
件数は約500件(500行)程度で、毎回変更します。

H2とL2に計算式を入れて、
セルH2の値をH3にコピー、セルL2の値をL3に...続きを読む

Aベストアンサー

方法はいくつかあると思いますが。。。

'-------------------------------------
Sub Test1()
 Dim Lastrow As Long
 Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("H2").AutoFill Range("H2:H" & Lastrow)
 Range("L2").AutoFill Range("L2:L" & Lastrow)
End Sub
'--------------------------------------
Sub Test2()
 Dim Lastrow As Long
 Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("H2").Copy Range("H3:H" & Lastrow)
 Range("L2").Copy Range("L3:L" & Lastrow)
End Sub
'-----------------------------------
Sub Test3()
 Dim R As Long
 For R = 3 To Cells(Rows.Count, "A").End(xlUp).Row
   Range("H2").Copy Cells(R, "H")
   Range("L2").Copy Cells(R, "L")
 Next R
End Sub
'---------------------------------

A列のデータで最終行を判断してます。
 

方法はいくつかあると思いますが。。。

'-------------------------------------
Sub Test1()
 Dim Lastrow As Long
 Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("H2").AutoFill Range("H2:H" & Lastrow)
 Range("L2").AutoFill Range("L2:L" & Lastrow)
End Sub
'--------------------------------------
Sub Test2()
 Dim Lastrow As Long
 Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("H2").Copy Range("H3:H" & Lastrow)
 Range("L2").Copy Range("L3:L" &...続きを読む

Qマクロのコピー&ペーストの繰り返し作業について

今、マクロを使って単純な作業を繰り返したいと思っているのですが、その中でいくつかわからない点があるので質問することにしました。
まず、貼り付けたい元データ(説明上data1と呼びます)が40種類あります。
これらは、すべて異なるファイル名をつけており、1つのフォルダ内に保存しています。
data1上のコピーをしたいと思っている場所は40種類ともすべて同じ場所(セルのH3)です。
これを、まったく新しいエクセルファイル(説明上resultと呼びます)に貼り付けたいと思っています。
このとき、data1の40種類のデータをresultのシート上にA1から順番に縦に並べていきたいと思っています。
この作業をdata1のファイル数である40回繰り返したいと思っているのですが、どうすればいいのでしょうか。

回答をお願いします。

Aベストアンサー

データのコピー元およびコピー先を明確に書いていただいてないので適当に作成しtwみました。
以下の前提です。

元データはすべて同じフォルダ内にあるBOOKの1枚目(一番左)のシート(名前を問わない)のH3セルにある。
あなたがresultと呼んだコピー先のBOOKの1枚目(一番左)のシートのA1セル以降に順番に貼り付ける。

それでよければ以下のマクロをresultと呼んだコピー先のBOOKの標準モジュールに貼り付け、元データと同じフォルダ内に保存してください。
マクロは書いたことは無くとも、標準モジュールに貼り付けるくらいはできるんですよね?

Sub TEST01()
  Dim myFn As String
  Dim i As Long
  Dim wb As Workbook '以上変数宣言
  Application.ScreenUpdating = False '画面更新一時停止
  myFn = Dir(ThisWorkbook.Path & "\*.xls?") 'エクセルBOOK検索
  Do While myFn <> "" '対象が存在する限り続行
    If myFn <> ThisWorkbook.Name Then 'ファイル名がresultの名と違っていれば
      Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & myFn) '開く
      i = i + 1 'カウント
      wb.Worksheets(1).Range("H3").Copy ThisWorkbook.Worksheets(1).Cells(i, "A") 'コピペ
      wb.Close False '閉じる
    End If
    myFn = Dir() '次検索
  Loop '繰り返し
  Application.ScreenUpdating = True '画面更新停止解除
End Sub

ALT+F8キーでマクロを呼び出し、TEST01を実行してみてください。

データのコピー元およびコピー先を明確に書いていただいてないので適当に作成しtwみました。
以下の前提です。

元データはすべて同じフォルダ内にあるBOOKの1枚目(一番左)のシート(名前を問わない)のH3セルにある。
あなたがresultと呼んだコピー先のBOOKの1枚目(一番左)のシートのA1セル以降に順番に貼り付ける。

それでよければ以下のマクロをresultと呼んだコピー先のBOOKの標準モジュールに貼り付け、元データと同じフォルダ内に保存してください。
マクロは書いたことは無くとも、標準モジュールに...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。

以下のようなプログラムをVBAで作成したいと考えています。

A1のセルに値があれば、その値をB1に返す。
次にA2のセルに値があれば、その値をB2に返す。
A行に値がある一番下のセルまで同じようなことをさせたいと考えています。

VBAは初心者です。
どなかた宜しくお願い致します。

Aベストアンサー

#2さんと似たものですが・・・・参考にしてください。

Sub test001()
Dim i As Long
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 2) = Cells(i, 1)
i = i + 1
Loop
End Sub

QエクセルVBA 別シートの複数のセルの値をコピーする方法

いつもお世話になります。

Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")

sh1.Range("C6").Value = sh2.Range("F5").Value
として、1つのセルの値ならコピーできるのですが、
sh1.Range("C6:C10").Value = sh2.Range("F5;F9").Value
としても、セルの値を持ってくることができません。
どのように書けば良いのでしょうか?

ちなみに今は、
sh2.Range("F5:F9").Copy
sh1.Range("C5:C9").PasteSpecial Paste:=xlValues
としているのですが、上記だとセルを範囲指定してしまって作業が見えるのでカッコ悪いのです。

Aベストアンサー

7-samuraiの質問ですみません。
No5のimogasiさん、いつもお世話様です。

Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet2")
Set sh2 = Worksheets("sheet1")
sh1.Range("c1:c5").Value = sh2.Range("A1:A5").Value
End Sub

で、うまくいきますよ。
複数セルの場合Valueは省略できないようです。

QExcel で行を指定回数だけコピーしたい

Excel で行を指定回数だけ、コピーしたいと思います。

A    B   C   D    E
ssjj kkkk ssss jajj 2
jkjk jjkj jahj kjkj 4
ksks ssss kakk uhuh 0
kaka sakk kjkj iuiiu 1

このような表があった時、E列で繰り返しの回数を指定するとして
次のシートに以下のような表ができれば
いいのですが。

A     B     C     D     E
ssjj kkkk ssss jajj 2
ssjj kkkk ssss jajj 2
jkjk jjkj jahj kjkj 4
jkjk jjkj jahj kjkj 4
jkjk jjkj jahj kjkj 4
jkjk jjkj jahj kjkj 4
jkjk jjkj jahj kjkj 4
kaka sakk kjkj iuiiu 1



膨大な数のデータですのでVBAやマクロ
が使えるといいのですが。

よろしくお願いいたします。

Excel で行を指定回数だけ、コピーしたいと思います。

A    B   C   D    E
ssjj kkkk ssss jajj 2
jkjk jjkj jahj kjkj 4
ksks ssss kakk uhuh 0
kaka sakk kjkj iuiiu 1

このような表があった時、E列で繰り返しの回数を指定するとして
次のシートに以下のような表ができれば
いいのですが。

A     B     C     D     E
ssjj kkkk ssss jajj 2
ssjj kkkk ssss jajj 2
jkjk ...続きを読む

Aベストアンサー

>VBAやマクロが使えるといいのですが。
VBAでやれば簡単なロジックで出来るが、VBAの経験はあるのかな。
(A)E列に繰り返し数があると仮定している。
(B)2003までなら、データ数は65536行以内と仮定になる。
(E列の繰り返し数の合計が)
標準モジュールに
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
d = sh1.Range("A65536").End(xlUp).Row
MsgBox d
k = 1
For i = 1 To d
For j = 1 To sh1.Cells(i, "E")
sh1.Range(sh1.Cells(i, "A"), sh1.Cells(i, "E")).Copy _
sh2.Cells(k, "A")
k = k + 1
Next j
Next i
End Sub
ーー
質問例でのテスト  Sheet2に
ssjjkkkkssssjajj2
ssjjkkkkssssjajj2
jkjkjjkjjahjkjkj4
jkjkjjkjjahjkjkj4
jkjkjjkjjahjkjkj4
jkjkjjkjjahjkjkj4
kakasakkkjkjiuiiu1

>VBAやマクロが使えるといいのですが。
VBAでやれば簡単なロジックで出来るが、VBAの経験はあるのかな。
(A)E列に繰り返し数があると仮定している。
(B)2003までなら、データ数は65536行以内と仮定になる。
(E列の繰り返し数の合計が)
標準モジュールに
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
d = sh1.Range("A65536").End(xlUp).Row
MsgBox d
k = 1
For i = 1 To d
For j = 1 To sh1.Cells(i, "E"...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Q選択した項目を上から順番にコピーするマクロ

いつもお世話になっております。
現在、チェックシートを作成しており、入力規則で”○”を選択した項目を別のセルに上から順番にコピーするマクロを考えていますが、まったく思いつきません。

 A          B       C    
1営業は好きだ            営業は気合だ   
2営業は気合だ      ○     営業は数だ
3営業は口八丁だ     
4営業は数だ       ○

と、したいのですが、どなたか、ご教示願います!

Aベストアンサー

チェックシートをSheet1、抽出先のシートをSheet2とします。
Sub Sample()

Dim Data As Range
Dim i As Long
Dim j As Long

Set Data = Sheets("Sheet1").Range("A1").CurrentRegion

j = 1

For i = 1 To Data.Rows.Count
If Data.Cells(i, 2) = "○" Then
Sheets("Sheet2").Cells(j, 1) = Data.Cells(i, 1)
j = j + 1
End If
Next

Set Data = Nothing
End Sub

Qエクセル VBA 繰り返し コピー貼り付け

以下を繰り返し作業をOffsetを使用して行いたいのですがどうすればいいでしょうか?
Sheets("Sheet1").Select
Range("A1:C1").Select のA1:C1以下へA1000:C1000ぐらいあります。
Sheets("Sheet2").Select
Range("G1").Select は貼り付けたセル3つの数字の組み合わせで公式に使う計算期間がまちまちですので公式を張り付けたり出来ません。
D1の解を
heets("Sheet1").Select
Range("D1").Select に貼り付けてA1:C1以下1000までの結果を評価出来るようにしたいのですが!

' Macro1 Macro
Sheets("Sheet1").Select
Range("A1:C1").Select
Selection.Copy
Sheets("Sheet2").Select
Range("D1").Select
ActiveSheet.Paste
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D1").Select
ActiveSheet.Paste
Range("A2:C2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("D1").Select
ActiveSheet.Paste
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D2").Select
ActiveSheet.Paste
Range("A3:C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("D1").Select
ActiveSheet.Paste
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D3").Select
ActiveSheet.Paste
End Sub

よろしくおねがいします。

以下を繰り返し作業をOffsetを使用して行いたいのですがどうすればいいでしょうか?
Sheets("Sheet1").Select
Range("A1:C1").Select のA1:C1以下へA1000:C1000ぐらいあります。
Sheets("Sheet2").Select
Range("G1").Select は貼り付けたセル3つの数字の組み合わせで公式に使う計算期間がまちまちですので公式を張り付けたり出来ません。
D1の解を
heets("Sheet1").Select
Range("D1").Select に貼り付けてA1:C1以下1000までの結果を評価出来るようにしたいのですが!

' Macro1 Macro
...続きを読む

Aベストアンサー

Offsetはこのような処理では、一般的ではないと思います

Sub test()
Dim i As Long
For i = 1 To 1000
Sheets("Sheet1").Select
Range(Cells(i, 1), Cells(i, 3)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("D1").Select
ActiveSheet.Paste
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Cells(i, 4).Select
ActiveSheet.Paste
Next i
End Sub


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

人気Q&Aランキング