OCN光で最大124,800円おトク!

EXCEL VBAで条件に一致するセルを別のブックの複数のシートへコピーして
貼りたいのですが、どのようにしたらよいか教えて下さい。

(1)のブック、A列と、(2)のブックA列には順番はバラバラですが、同じデータ(数字とアルファベットの番号が入っています)これを元に、(1)のブックのK列のデータを(2)のブックシートa~dのY列に貼りたいのです。(シートa~dにはそれぞれ異なるデータが入っていますが、列数は一緒です。A列に入っているデータも(1)のブックと一緒です。)

お詳しい方どうかどうか宜しくお願い致します。

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

A 回答 (5件)

動作確認出来る環境が無いため、おかしければコメントして下さい。



Sub Macro1()
Dim LastRow1 As Long, FileName1 As String, FileName2 As String
Dim strSheetName(4) as String, LastRow(4) As Long

FileName1=Range("A1").Value '処理ファイル名を変数に代入
FileName2=Range("A2").Value

'2つのブックを開く。バックスラッシュ(/の反対)が見えたら、日本円マークに変更してください。
Workbooks.Open filnemae:=ThisWorkbook.Path & "\" & FileName1
Workbooks.Open filnemae:=ThisWorkbook.Path & "\" & FileName2

'各シートの最終行を取得
LastRow1 = Workbooks(FileName1).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
strSheetName(1)="a"
strSheetName(2)="b"
strSheetName(3)="c"
strSheetName(4)="d"

With Workbooks(FileName2)
For i=1 To 4
LastRow(i) =.Worksheets(strSheetName(i)).Cells(Rows.Count, "A").End(xlUp).Row
Next i
End With


'ブック2シートa~dのA列と同じ値がブック1シート1のA列にあれば、
'ブック1シート1K列の値をブック2シートa~dのY列にコピー

For j=1 to 4
with Workbooks(FileName2).Worksheets(strSheetName(j))
    .Columns("Y").ClearContents
For i = 1 To LastRow(j)
.Cells(i,"Y")=Application.Vlookup(.Cells(i,"A"), _
Workbooks(FileName1).Worksheets(1).Range("A1:K" & LastRow1),11,0)
Next i
.Range("Y1:Y" & LastRow(j)).Copy
.Range("Y1").PasteSpecial Paste:=xlPasteValues
End With
Next j
Workbooks(FileName1).close Savechanges:=False

End Sub
    • good
    • 2
この回答へのお礼

お礼が大変遅くなりまして本当に申し訳ありませんm(__)m
無事に作成する事が出来ました。ネットでこんなにもすぐに、そしてこんなにも親切丁寧にご回答頂けると思っていなかったので、本当に有難かったです。本当に有難うございましたm(__)m

お礼日時:2015/01/31 14:00

何度もごめんなさい。

訂正2です。

訂正前
Workbooks.Open filnemae:=ThisWorkbook.Path & FileName1 '2つのブックを開く
Workbooks.Open filnemae:=ThisWorkbook.Path & FileName2

訂正後
Workbooks.Open filnemae:=ThisWorkbook.Path & "\" & FileName1 '2つのブックを開く
Workbooks.Open filnemae:=ThisWorkbook.Path & "\" & FileName2
    • good
    • 1
この回答へのお礼

丁寧に教えて頂き、どうも有難うございますm(__)m

早速使用させて頂いたのですが、インデックスが有効範囲にありません。とエラーがでてきて

LastRow1 = Workbooks(FileName1).Worksheet(1).Cells(Rows.Count, "A").End(xlUp).Row

の箇所で止まってしまいます。

何度かやってみたのですが、ここから進む事ができません。ブック1もブック2もA列にデータは入っているのですが、原因がわかりません。

又、伝え方が悪くてすみません。ブック2のシート1、A列を参照するのではなく、シートa~dそれぞれのA列を参照したい形になるのですが、そちらの方法を教えて頂ければと思います。m(__)m

お礼日時:2015/01/23 01:30

すみません、訂正です。


セルA1,A2を一旦変数に代入しました。

Sub Macro1()
Dim LastRow1 As Long, FileName1 As String, FileName2 As String
Dim x As Variant

FileName1=Range("A1").Value '処理ファイル名を変数に代入
FileName2=Range("A2").Value

Workbooks.Open filnemae:=ThisWorkbook.Path & FileName1 '2つのブックを開く
Workbooks.Open filnemae:=ThisWorkbook.Path & FileName2

LastRow1 = Workbooks(FileName1).Worksheet(1).Cells(Rows.Count, "A").End(xlUp).Row 'ブック1シート1の最終行を取得

'以下、1行目からデータ最終行までループで回し、ブック1シート1のA列とブック2シート1のA列が同じなら、
'ブック1シート1K列の値をブック2シートa~dのY列にコピー

For i = 1 To LastRow1
If Workbooks(FileName1).Worksheets(1).Cells(i, "A").Value = Workbooks(FileName2).Worksheets(1).Cells(i, "A") Then
x = Workbooks(FileName1).Worksheets(1).Cells(i, "K").Value
With Workbooks(FileName1)
.Worksheets("a").Cells(i, "Y").Value = x
.Worksheets("b").Cells(i, "Y").Value = x
.Worksheets("c").Cells(i, "Y").Value = x
.Worksheets("d").Cells(i, "Y").Value = x
End With
End If
Next i
End Sub
    • good
    • 1

ブック1 一番左のワークシートを処理するものとします。


ブック2 一番左のワークシートを調べるものとします。転記先シート名はa~d

使用法
このマクロを新しいブックに貼って保存
ブック1、2を新しいブックと同一フォルダに置く
セルA1にブック(1)の名前を記入
セルA2にブック(2)の名前を記入
マクロ起動

Sub Macro1()
Dim LastRow1 As Long
Dim x As Variant

Workbooks.Open filnemae:=ThisWorkbook.Path & Range("A1").Value '2つのブックを開く
Workbooks.Open filnemae:=ThisWorkbook.Path & Range("A2").Value

LastRow1 = Workbooks(Range("A1").Value).Worksheet(1).Cells(Rows.Count, "A").End(xlUp).Row 'ブック1シート1の最終行を取得

'以下、1行目からデータ最終行までループで回し、ブック1シート1のA列とブック2シート1のA列が同じなら、
'ブック1シート1K列の値をブック2シートa~dのY列にコピー

For i = 1 To LastRow1
If Workbooks(Range("A1").Value).Worksheets(1).Cells(i, "A").Value = Workbooks(Range("A2").Value).Worksheets(1).Cells(i, "A") Then
x = Workbooks(Range("A1").Value).Worksheets(1).Cells(i, "K").Value
With Workbooks(Range("A2").Value)
.Worksheets("a").Cells(i, "Y").Value = x
.Worksheets("b").Cells(i, "Y").Value = x
.Worksheets("c").Cells(i, "Y").Value = x
.Worksheets("d").Cells(i, "Y").Value = x
End With
End If
Next i
End Sub

ほぼ同一機能を持ったマクロを自動マクロでも作れます。表現はちょっと変わりますが。マクロを作る時にコマンドが分らない場合、自動マクロを使ったりします。
    • good
    • 2

・条件は?


・コピー先Y列というのは、同じ行に貼っていいのですか?上から詰めて貼るのですか?

この回答への補足

条件というのは、『1)のブック、A列と、(2)のブックA列のセルが同じデータだったら』というところです。
又、コピー先Y列は、同じ行に貼る形です。A列のセルに入っているデータが合致したら、その同じ行のY列に貼る形です。
とてもわかりずらい説明でごめんなさい。
宜しくお願い致しますm(__)m

補足日時:2015/01/20 21:10
    • good
    • 0

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

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

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

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

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....続きを読む

Q複数条件が一致で別シートに転記【エクセルVBA】

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
------------------------------------------------
2 たけだ  配達  6/20(月) 13:00  2個
3 みうら  配達  6/18(土) 14:00  4個
4 らもす  郵送  6/20(月)  ―   5個
5 いはら  配達  6/20(月) 14:30  8個
6 かつや  配達  6/20(月) 15:00  6個
7 みうら  郵送  6/20(月)  ―   4個

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00
3  12:30
4  13:00
5  13:30
6  14:30
7  15:00
8  15:30
9  16:00

マクロを実行すると・・・
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

■シート名:配達表
    A     B    C
------------------------------------
1  配達   6/20(月)
------------------------------------
2  12:00 
3  12:30
4  13:00    たけだ   2個
5  13:30
6  14:00    みうら   4個
6  14:30   いはら   8個
7  15:00   かつや   6個
8  15:30
9  16:00

エクセルでセルの条件が複数一致したら別シートに転記される方法をお教えください。
シートを2枚用意して、配達日ごとに一覧化したいのです。
事前に用意したシート(配達表)の“配達”と“配達時間”が一致したら
その方の名前と注文個数を右側に反映したいのですが・・・

注文データが多すぎて困っています。
宜しくお願いします。

■シート名:注文データ
   A    B    C    D    E
------------------------------------------------
1 しめい  対応   配達日   時間   個数
-...続きを読む

Aベストアンサー

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表は、VBAを勉強してそれを使うべきと思う(既に回答も出ているようだ)
関数で抜き出し問題や表の組み換えは、VBAで無いと、天下りの長い式をコピペで使うだけになる。
ーー
私が紹介している「imogasi方式」では、Sheet2に時刻の所定の行に出す問題なので複雑になりすぎる。
ーー
VBAでやってみる。
例データ
しめい対応配達日時間個数
たけだ配達6月20日13:002個
みうら配達6月18日14:004個
らもす郵送6月20日ーー5個
いはら配達6月20日14:308個
かつや配達6月20日15:006個
みうら郵送6月20日ーー4個
(注意)
「ーー」セルは空白とする
「月日」列は、エクセルの年月日を入れておくこと(日付シリアル値(わかりますか)) 文字列では不可
6/20(月) の様な表示は、表示形式の設定でやること(エクセルの常識)  m/d(aaa)
時間の列も時刻シリアル値で入れてあるとする。文字列では不可
ーー
コード
標準モジュールに
Sub test01()
Dim sh1, sh2
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
On Error Resume Next
For i = 2 To d
'--条件をかけて選別
If sh1.Cells(i, "B") = "配達" And sh1.Cells(i, "C") = sh2.Range("B1") And _
sh1.Cells(i, "D") <> "" Then
t = sh1.Cells(i, "D")
'---Sheet2で時刻行を探す
For r = 2 To 30
If sh1.Cells(i, "D") = sh2.Cells(r, "A") Then Exit For
Next r
'--該当行の値をSheet2の時刻該当行セット
Sheet2.Cells(r, "B") = sh1.Cells(i, "A")
Sheet2.Cells(r, "C") = sh1.Cells(i, "E")
End If
Next i
End Sub
ーー
実行結果
Sheet2
配達6月20日
12:00
12:30
13:00たけだ2個
13:30
14:00
14:30いはら8個
15:00かつや6個
15:30
16:00
・・・・・・

こういうのは「複数条件による抜き出し問題」だ。
関数で出来ればおなじみのやり方で良いのだが、既に出ているように式が長く複雑で、初心者には何をやって居るかわからない式になる。毎度週に数回このタイプの質問が出て、同じようなタイプの答えになる。Googleででも「imogasi方式」で照会すれば、過去の沢山の例と回答(そのタイプも)が出てくる。
ーー
まず初心者や急ぐ場合はデーターフィルターフィルタオプションの設定で済ませられないか勉強すべきだ。
ーー
本来、こういう仕事の関連のエクセル表...続きを読む

QVBA 条件が一致した場合のみコピーする

VBAについて、現在勉強中な為、色々調べておりますが、詳しい方がおりましたら教えてください。

在庫管理の表をエクセルでやっております。

注文が来て、品物の手配をする時に、在庫の有無を確認したいので下記のような事が出来れば
良いと思っております。
3つのシートを使っております。シート名は、”必要数””出荷数””在庫数”

シート:”在庫数”では、入荷数の合計から、マクロを使ってコピーした”出荷数”の数を
差し引くことにより、発注手配が必要な物とそうでない物がわかりやすいように作りたいと思って
おります。

今回は、注文来た数を出荷数のシートにVBAでコピーさせる方法の質問です。

シート名:”必要数” のセルC2:C:50 を、コピーして、隣のシート”出荷数”のA列の
一番上の空白に、形式を選択して貼り付け(値・行列を入れ替える)
ただし、A列には、日付が入力されてる為、参照した空白の一つ上のセルがコピー元と同じ
日付なら、貼り付けをしないでエラー表示させたい。

自動マクロでは、コピー元を選択して、ここに貼り付けみたいな事はできたのですが
3行目に貼り付けした後は、4行目に貼り付けるという自動マクロがわかりません。

ネットで調べたコードを何個もコピペしてやってみたのですが、なかなかうまく行きません。

詳しい方がおりましたら、コードを教えて頂けると助かります。
どうぞ、宜しくお願い致します。

VBAについて、現在勉強中な為、色々調べておりますが、詳しい方がおりましたら教えてください。

在庫管理の表をエクセルでやっております。

注文が来て、品物の手配をする時に、在庫の有無を確認したいので下記のような事が出来れば
良いと思っております。
3つのシートを使っております。シート名は、”必要数””出荷数””在庫数”

シート:”在庫数”では、入荷数の合計から、マクロを使ってコピーした”出荷数”の数を
差し引くことにより、発注手配が必要な物とそうでない物がわかりやすいように作りたいと思っ...続きを読む

Aベストアンサー

実証出来る環境に移動出来たので、実証してみました(苦笑)
したらば、案の定コードのミスが2か所。Offset(1)が抜けていたことと
PasteSpecialはPasteとは違って、Selectionで動くこと・・・です。

ま、それを直したのがこれですが。

Sheets("必要数").activate
CHK = Range("C2").Value
Range("C2:C50").copy

Sheets("出荷数").activate
Range("A65536").End(xlUp).Offset(1).Select

IF Selection.Offset(-1).Value<>CHK Then
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Else
  Msgbox "日付が重複しています"
End If

ところで、当然こいつを動かすには前提条件とコピー先シートの準備が
必要です。あまりVBAに慣れていないようなので、コードの解説をしつつ。


まずは

Sheets("必要数").activate
CHK = Range("C2").Value

これで、必要数シートのC2:C50セルの先頭データを変数として取り込みます。
変数名は仮に「CHK」としましたが、これは私の癖で「日付」とかでもいいです。

Range("C2:C50").copy

これでコピーの準備をします。

Sheets("出荷数").activate
Range("A65536").End(xlUp).Offset(1).Select

これは「件数が判らない時の最終行の求め方の定番コード」です。End(xlUp)で
[Ctrl]+[↑]と同じ動きをします。要は「一番下の行から続いている空白の、一番
上のセルに飛ぶ」という処理になります。
http://www.happy2-island.com/excelsmile/smile03/capter00702.shtml

次に

IF Selection.Offset(-1).Value<>CHK Then

これで、一番上の空白のもう一つ上のセル=データの入ってる最終セルを見に
行きます。これが、事前に保管しておいた変数の内容とあっているかチェックする
訳ですね。

当然このことから、コピーする先のシートには、事前に最低でもA1セルに何か
入ってないとエラーする(A1セルに飛んじゃうと、Offset(-1)に当たるセルが存在
しない)ということも判ります。

で、

Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True

これで「行列を入れ替えて値貼り付け」というわけです。


ちなみに、これだけだと、処理は1回しか動きません。

複数回動かすには、例えばDo~Loopとかして、コピー元を順次変えていくという
ようなコードも必要ですが・・・それは大丈夫なんですよね?

実証出来る環境に移動出来たので、実証してみました(苦笑)
したらば、案の定コードのミスが2か所。Offset(1)が抜けていたことと
PasteSpecialはPasteとは違って、Selectionで動くこと・・・です。

ま、それを直したのがこれですが。

Sheets("必要数").activate
CHK = Range("C2").Value
Range("C2:C50").copy

Sheets("出荷数").activate
Range("A65536").End(xlUp).Offset(1).Select

IF Selection.Offset(-1).Value<>CHK Then
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Else
  M...続きを読む

Qエクセルで、条件に一致した行を別のセルに抜き出す方法

エクセルで、指定した条件に一致するセルを含む行をすべて抜き出す方法が知りたいです。

たとえば、

<A列> <B列> <C列>
7/1 りんご 100円
7/2 ぶどう 200円
7/2 すいか 300円
7/3 みかん 100円

このような表があって、100円を含む行をそのままの形で、
別のセル(同じシート内)に抜き出したいのですが。

7/1 りんご 100円
7/3 みかん 100円

抽出するだけならオートフィルターでもできますが、
抽出結果を自動的に、別の場所に、常に表示させておきたいのです。

初歩的な質問だと思いますが、検索しても分からなかったので、よろしくお願いします。

Aベストアンサー

同じ質問が結構よく出てますが、そんなに初歩的でもありません
別シートのA1セルに「100円」と入力し、そのシートの任意のセルに以下の式を貼り付けて下さい。後は、下方向、右方向にコピー。
日付のセル書式は「日付」形式に再設定してください

=IF(COUNTIF(Sheet1!$C:$C,$A$1)>=ROW(A1),INDEX(Sheet1!A:A,LARGE(INDEX((Sheet1!$C$1:$C$500=$A$1)*ROW(Sheet1!$C$1:$C$500),),COUNTIF(Sheet1!$C:$C,$A$1)-ROW(A1)+1)),"")

データ範囲は500行までとしていますが、必要に応じて変更して下さい

QEXCELで別のシートのデータを参照して返す方法

ちょっとしたことなのですが、うまく式が書けなくて悩んでいます。

作業用のシート1と参照用のシート2があり、
シート1のA列には
 あおき
 あべ
 いぐち
 いはら
などと文字列(名前)が入力されています。
こちらは今度の野球のスタメンだと思ってください。

シート2にはA列とB列があって、
わたなべ 55
いぐち  43
あおやま 67
いはら  41
などと、名前:背番号が羅列されています。こちらが参照用の全選手の背番号リストだと思ってください。

ここで、 シート1のB列に、A列の名前に対応した背番号を返したいのです。
なので、シート1のB列に
IF(シート1のA列の値=シート2のA列のいずれかの値)だったとき、
適合したシート2の行のB列の値を表示する
という式を入れたいのですが、どのように式を書けばよいでしょうか。

すみませんがどなたか教えてください。

Aベストアンサー

私もその場合はVLOOKUP関数を使用しています。

「B1」=VLOOKUP(A1,Sheet2!$A:$B,2,0)

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は省略できないようです。

QエクセルVBAで違うブックの指定セルの値をコピーするコード

同じフォルダ内に次のブックがあります。
・「日報」フォルダ
・「入力」ブック
・「日報」ブック

「日報」ブックの「入力」シートのセルに入力して、ボタンを押すと
「日報」ブックの指定のセルに順にコピーしていくようにしたいの
ですが、コードをお教えいただけないでしょうか?
具体的には次のようになります。

「入力」ブックの「入力」シート→「日報」ブックの「日報」シート
A2,C2,D2,E2,F2→→→→→→A5,D5,F5,L5,P5
A3,C3,D3,E3,F3→→→→→→A6,D6,F6,L6,P6
A12,C12,D12,E12→→→→→→A34,J34,E34,E35
A13,C13,D13,E13→→→→→→A36,J36,E36,E37

このように入力されるようにしたいと思います。
実際にはもう少し同じようにコピーするところが
あるので、後でセル番地を追加できるようなコード
であれば非常にありがたいです。コードを教えて
ほしいなんて本当にずうずうしいですが、どうぞ
よろしくお願いします。

Aベストアンサー

#3です。直すのは簡単です。
マクロは日報ブックに、対比表も日報ブックのSheet2に作成としてください。
Sub test()
Dim sourceRange As Range
Dim destRange As Range
Dim sourceAddress As String
Dim destAddress As String
Dim addressTable As Range
Dim i As Long

Set addressTable = ThisWorkbook.Sheets("Sheet2").Range("A1").CurrentRegion
For i = 1 To addressTable.Rows.Count
sourceAddress = addressTable.Cells(i, 1).Value
destAddress = addressTable.Cells(i, 2).Value
Set sourceRange = Workbooks("入力.xls").Sheets("入力").Range(sourceAddress)
Set destRange = ThisWorkbook.Sheets("日報").Range(destAddress)
destRange.Value = sourceRange.Value
Next i
End Sub

#3です。直すのは簡単です。
マクロは日報ブックに、対比表も日報ブックのSheet2に作成としてください。
Sub test()
Dim sourceRange As Range
Dim destRange As Range
Dim sourceAddress As String
Dim destAddress As String
Dim addressTable As Range
Dim i As Long

Set addressTable = ThisWorkbook.Sheets("Sheet2").Range("A1").CurrentRegion
For i = 1 To addressTable.Rows.Count
sourceAddress = addressTable.Cells(i, 1).Value
d...続きを読む

Q異なるブック間でのセル範囲のコピー/VBA

異なるブック間でクリップボードを経由せず直接コピーしたいため
下記のマクロを記述していますが、実行エラーが発生します。
どうしてでしょうか。

ThisWorkbook.Worksheets(3).Range(Cells(3, 1), Cells(3 + a, 1)).Value = Workbooks("excel.xls").Worksheets(1).Range(Cells(11, 3), Cells(11 + a, 3)).Value

(補足)
(1)VBA実行中のThisWorkbook、excel.xlsは別のブック
ですが、同じフォルダにあります。
(2)aは数値が入る変数です。

Aベストアンサー

Cells(3, 1)や他のCellsが参照エラーになるためです。
ブックとワークシートを特定できないためエラーになってしまいます。
正しくは
ThisWorkbook.Worksheets(3).Range(ThisWorkbook.Worksheets(3).Cells(3, 1), _
ThisWorkbook.Worksheets(3).Cells(3 + a, 1)).Value _
= Workbooks("excel.xls").Worksheets(1).Range(Workbooks("excel.xls").Worksheets(1).Cells(11, 3), _
Workbooks("excel.xls").Worksheets(1).Cells(11 + a, 3)).Value

Qある条件を満たすセルに対応する行のセル内容をコピーして・・

ある条件を満たすセルに対応する行のセル内容をコピーして・・

 いつもお世話になっております。エクセルVBAのほぼ初心者です。

ある列の一部(たとえばE100~200)において、ある条件を満たすセル(たとえば<30)を
すべて検索して(たとえばE110とE130)、そのセルの行にある別列のセル内容(たとえば
A110とB110、およびA130とB130)をコピーして、別のワークシートのとある場所(たとえ
ばB2)に貼り付ける。

 というようなマクロを作成したいのですが、自分の力量では難しいのです。。
 Do~Loopなどを利用すればよいのでしょうか?
 いい方法がありましたらどうぞよろしくお願いいたします。

Aベストアンサー

Excelに元々備わっている機能を使うなら

Sub Macro1()
  Dim r As Range
  
  With Sheets("sheet1") '元シート
    Set r = .Range("E99:E200") '検索範囲+直上行
    .AutoFilterMode = False
    'AutoFilterで抽出条件設定
    r.AutoFilter Field:=1, Criteria1:="1"
    If r.SpecialCells(xlCellTypeVisible).Count = 1 Then
      MsgBox "no data"
    Else
      Intersect(r.Offset(, -4), r.Offset(1, -4)).Resize(, 2).Copy _
           Sheets("sheet2").Range("B2") 'コピー先
    End If
    .AutoFilterMode = False
  End With

  Set r = Nothing
End Sub

こんな感じもあります。
シート名やアドレス等は適宜修正してください。
コピー先に既存データがあるなら、コピー前にクリア処理も必要かと。

Excelに元々備わっている機能を使うなら

Sub Macro1()
  Dim r As Range
  
  With Sheets("sheet1") '元シート
    Set r = .Range("E99:E200") '検索範囲+直上行
    .AutoFilterMode = False
    'AutoFilterで抽出条件設定
    r.AutoFilter Field:=1, Criteria1:="1"
    If r.SpecialCells(xlCellTypeVisible).Count = 1 Then
      MsgBox "no data"
    Else
      Intersect(r.Offset(, -4), r.Offset(1, -4)).Resize(, 2).Copy _
           She...続きを読む


人気Q&Aランキング