人に聞けない痔の悩み、これでスッキリ >>

エクセルVBAでSheet2の指定のセルをコピーして、
Sheet1にある表の中の指定の列の空白セルを探して貼り付けるVBAを作成したいのですが、うまく出来ません。
Sheet1の表は1行目、2行目は見出しの項目が並んでいます。
3行目から50行目までは値を入力するようになっていて、
51行目はそれらをの集計が表示されるようになっています。
下記のVBAを作成したら3行目~50行目までの空欄に貼り付けず、
52行目に貼り付けてしまいます。
-----------------------------------------------------------
Sheets("Sheet2").Range("B6").CurrentRegion.Copy
Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
------------------------------------------------------------
修正して頂けないでしょうか?
宜しくお願いします。

A 回答 (2件)

> 51行目はそれらをの集計が表示されるようになっています。



ということは、51行目には数式がはいっているんですね?
だから52行目から張り付いてしまうんです。

Sheets("Sheet1").Cells(51, "B").End(xlUp).Offset(1).PasteSpecial xlPasteValues

なら大丈夫なはずですよ。
    • good
    • 1
この回答へのお礼

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

意図していた通りの動作が出来ました。
感謝致します。

お礼日時:2010/02/10 21:10

こんな感じで


>Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial xlPasteValues

Sheets("Sheet1").Cells(1, "B").End(xlDown).Offset(1).PasteSpecial xlPasteValues
へ変更

以上、参考まで
    • good
    • 1
この回答へのお礼

回答ありがとうございました。
教えて頂いた関数ではうまく出来ませんでした。

お礼日時:2010/02/10 21:09

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

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

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

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

Qマクロで空白セルに貼り付ける

エクセルで表を作っていますが、マクロを使って、空白セルの左隣の値をコピーし、空白セルに貼り付けをしたいのですが、うまくいきませんでしたので、教えてください。

Aベストアンサー

処理例を書いてい見ました。
空白セルを左のセルに置き換えたい範囲(連続範囲、飛び離れた範囲)を選択して実行します。
シートのコードウインドウに貼り付けます。 ご参考に。

Sub Okikae()
  Dim rg As Range              'セル
  For Each rg In Selection          '選択範囲での処理
    If rg.Column <> 1 Then         '1列目でなかったら
      If rg.Value = "" Then       '空白だったら
        rg.Value = rg.Offset(0, -1)  '左のセルと同じにする
      End If
    End If
  Next
End Sub

Q【Excel】【VBA】空白のセルに上のデータを入力する方法

  A  B    C
1 山田 地下鉄  160 
2    地下鉄  150
3    タクシー 1120
4    地下鉄  150
5 鈴木 地下鉄  210
6    タクシー 5220

上記のようなデータがあり、VBAで別シートに
A2~A4までA1の山田が、A6にはA5の鈴木が
入った形でコピーしたいのですが、実現可能でしょうか?
よろしくお願いいたします。

Aベストアンサー

Dim i As Integer
Dim S As String
S = ""
For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(i, 1).Value = "" Then
Cells(i, 1).Value = S
Else
S = Cells(i, 1).Value
End If
Next i

QEXCEL VBA マクロ 別シートの空白行へのコピー

すみません、、いくらやってもできません。どなたかわかるかた助けてください。

<質問内容>
エクセルのsheet1、Sheet2があり、
Sheet2にあるデータをSheet1のA列の空白行に貼り付けするというマクロを組みたいです。

BVAを使って、Sheet1の任意のデータ(データが入っているところのみ)をコピーすることまではできましたが、Sheet2へのA列空白行へペーストができないでいます。

※Sheet2は別会社で作成のため、シート保護されていますが、貼り付けたい場所はロックされていません。
保護されているがゆえにCtr+Gのセル選択は使用できない状態です。

すみませんが、明日までになんとかお願いいたします!明日中に作成、上司に渡す予定です。

Aベストアンサー

> Sheet1のA列の空白行に貼り付けするという
「空白行」の定義を詳しく!

「コピーまでできていて貼り付けができない」だけなら、
いったん別ブックで、コピペを「マクロの記録」でVBAのコード作成するのも手だし。

実は「なさりたいこと」が、「飛び飛びの行のデータをまとめたい」なら、
セルA1をクリック、右クリックの「形式を選択して貼り付け-値」で
対応できることなのかも。

「途中の空白行を除去したい」なら、
1)ある一列に連番振って、
2)データがある列でソートして、
3)空白行となる1)のデータをひとまとめに消して、
4)1)で再ソートして、
5)1)を消す
もできるだろうし。

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ある範囲のセルから任意の値を検索して、その隣のセルの値を取得するという関数はありますか?

Excelの関数について質問します。
ある範囲のせるを検索して、その隣のセルの値を取得するという関数を探しています。
なければユーザー定義で作りたいと思っています。
VLOOKUP関数では一番左端が検索されますが、
それをある範囲まで拡張して、
その右隣の値を取得できるようにしたいのです。
どうかお知恵をお貸しください。

Aベストアンサー

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場合によっては、IFをかぶせてCOUNTIFで確認した方が良いかもしれません。
 ex. =IF(COUNTIF(A1:F200,X1)=1,【上記数式】,"えらー")

ちなみに、VBAでやるならこんな感じになるかと。

動作の概要
 【検査範囲】から【検査値】を探し、
 最初にHITしたセルについて、右隣のセルの値を返す。
 ex. =Sample(X1,A1:F200)

'--------------------------↓ココカラ↓--------------------------
Function Sample(ByVal 検査値 As Variant,ByVal 検査範囲 As Range)
 For Each セル In 検査範囲
  If セル = 検査値 Then Exit For
 Next セル
 Sample = セル.Offset(0, 1)
End Function
'--------------------------↑ココマデ↑--------------------------

いずれもExcel2003で動作確認済。
以上ご参考まで。

●X1セルの値を範囲A1:F200の中から探して、その右隣のセルの値を返す

 =OFFSET(A1,SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1))-1,SUMPRODUCT(COLUMN(A1:F200)*(A1:F200=X1)))

※最初のA1はワークシートの左上隅を示すものなので、検索範囲に関わらずA1固定
※SUMPRODUCT(ROW(A1:F200)*(A1:F200=X1)) ⇒ A1:F200で値がX1と一致するセルの行番号

>その「ある範囲」の中には検索したい値が入っているセルは1つしかありません。
というのが前提です。複数のセルがHITすると関係ないセルの値が返るので、
場...続きを読む

Qexcel2010 空白セルにのみ貼り付けたい

excel2010使用 空白セルにのみ貼り付けたいのですが、

①の空白セルにのみ、②のデータを
貼りつけたいのですが、一括で簡単に出来る方法はあるでしょうか?
excel初心者の為、マクロとかは理解しておりません。
よろしくお願いいたします。
(逆に②を①に貼る、「形式を選択して貼り付け→すべて、演算しない、空白セルを無視する」
は、望む方法ではありません。)

Aベストアンサー

添付図参照
1.式 =IF(1/(C2=""),C7) を入力したセル C11 を右方および
 ̄ ̄下方にオートフィル
2.範囲C11:G13 を選択して、Ctrl+G を実行後、[セル選択]
 ̄ ̄をツン
3.“数式”に目玉入れて、かつ、“エラー値”以外のチェックを
 ̄ ̄外して、[OK]をツン
6.Deleteキーをパシーッ
7.範囲C11:G13 を選択
8.Ctrl+C をパシーッ
9.セル C2 を選択して、マウスの右クリックから[形式を選択
 ̄ ̄して貼り付け]メニューを表示
10.“値”に目玉を、“空白セルを無視する”にチェックを入れて、
 ̄ ̄Enterキーを「エイヤッ!」と叩きつけ

「空白セルを無視する」を利用しないテはアンメーに!

QVBAで別エクセルファイルから指定エクセルファイルにシートをコピー

Office2003のエクセルでVBAを勉強しております。

そこで、VBAで別エクセルファイルからあるシートを指定エクセルファイルへ丸まるコピーしたい場合にはどのようにすればよいのでしょうか?

Aベストアンサー

Sheets("A").Copy Before:=Workbooks("Book1").Sheets(1)


>Office2003のエクセルでVBAを勉強しております。

方法が解らなければ、記録マクロを確認するのが一番です。
動作が理解出来たら、コードの最適化を行ってください。

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のVBAで最終行の下にコピーする方法

ExcelのVBAについて勉強中です。

Excel2003で表から表への転記を行いたいのですが、
コードがうまく書けないため、教えていただきたいです。

やりたいこととしましては、
A1:D6のうちピンクの部分を、横一列に並べ替えながら、
F1:M6の色つきの部分(実際はより横に広くなります)に転記したいです。

ピンクの部分はその都度、値を変えて、
黄→緑→水色→青→紫・・・
と毎回マクロを実行するたびに最下行に追加できるような形にしたいです。

また、画像は同じシートに転記をしていますが、
別のシートの同様の表から同じように転記する場合、
どうコード変わるかも教えていただけましたら助かります。

自分では、下記のようなコードしか書けませんでした。
転記先の表は30列程度になる予定ですので、
出来ればシンプルなコードを教えていただきたいです。


Sub コピー()

Range("B2").Select
Selection.Copy
Range("G2").End(xlUp).Offset(1).Select
ActiveSheet.Paste

End sub


分かりづらい説明かと思いますが、
よろしくお願いします。

ExcelのVBAについて勉強中です。

Excel2003で表から表への転記を行いたいのですが、
コードがうまく書けないため、教えていただきたいです。

やりたいこととしましては、
A1:D6のうちピンクの部分を、横一列に並べ替えながら、
F1:M6の色つきの部分(実際はより横に広くなります)に転記したいです。

ピンクの部分はその都度、値を変えて、
黄→緑→水色→青→紫・・・
と毎回マクロを実行するたびに最下行に追加できるような形にしたいです。

また、画像は同じシートに転記をしていますが、
別のシートの同様の...続きを読む

Aベストアンサー

その程度の転写なら、あんまりカッコつけてやろうとせずに1個ずつ順番に転記してった方が、シンプルで間違いもありません。

sub macro1()
 dim h as range
 dim c as long
 dim LastRow as long

’貼り付け先行
 lastrow = worksheets("Sheet2").range("G65536").end(xlup).offset(1).row
’貼り付け先列
 c = 7 ’G列

 for each h in worksheets("Sheet1").range("B2:D6") ’コピー元
  worksheets("Sheet2").cells(lastrow, c).value = h.value
  c = c + 1 ’右の列に
 next
end sub

QVBA別シートの最終行の下行へ貼り付けされるようにしたいです。

教えてください。ド素人です。(参考書読み始めたところ)
聞き方も適切かわからないのですが、質問させてください。

Sheet1(入力画面)、Sheet2(確認画面)、Sheet3(データ)の3つのシートを作りました。

Sh1「入力画面」で入力された値は、関数で自動的に、Sh2「確認画面」指定のセルへコピーされるようにしています。
Sh1「入力画面」を入力し終えると。画面下のコマンドボタンで、Sh2「確認画面」へ画面が変わります。

そこで、内容を確認して、また、ここの下のコマンドボタンをクリックしてもらうと、Sh2「確認画面」の内容が、
Sh3(データ)の1行に集約されて貼り付けられます。同時にSh1「入力画面」の値は、クリアされ、Sh2「確認画面」も同様にクリアになります。

ここまで、完成したのですが、また、次のデータを入力していき、最後のSh3「データ」の最終行の下(空白行)に次々データを追加していくためのコードが解りません。

Sub ボタン3_Click()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Worksheets("入力画面")
Set sh2 = Worksheets("確認画面")
Set sh3 = Worksheets("データ")

With sh2
.Range("C2:E2").Copy
Sheets("データ").Range("B2:D2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C3:C5").Copy
Sheets("データ").Range("E2:G2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, True
.Range("C6:D6").Copy
Sheets("データ").Range("H2:I2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C7:D7").Copy
Sheets("データ").Range("J2:K2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C8:D8").Copy
Sheets("データ").Range("L2:M2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C9:D9").Copy
Sheets("データ").Range("N2:O2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
.Range("C10:C14").Copy
Sheets("データ").Range("P2:T2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, True
.Range("C17").Copy
Sheets("データ").Range("U2").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
End With

With sh1
.Range("D8:K8").ClearContents
.Range("D6:K6").ClearContents
.Range("D4:K4").ClearContents
.Range("D10:K10").ClearContents
.Range("D12:J12").ClearContents
.Range("D14:L14").ClearContents
.Range("L16").ClearContents
.Range("D16:J16").ClearContents
.Range("D18:J18").ClearContents
.Range("L18").ClearContents
.Range("L20").ClearContents
.Range("D20:J20").ClearContents
.Range("L22").ClearContents
.Range("D22:J22").ClearContents
.Range("D24:H24").ClearContents
.Range("D26:H26").Value = "90"
.Range("D28:H28").Value = "80"
.Range("D30:H30").Value = "5"
.Range("D32:H32").Value = "5"
End With
Worksheets("入力画面").Activate
End Sub

ここまで、試行錯誤した内容です。
どこに最終行の下(空白行)の記述をいれられますでしょうか?
画像が一枚しかのせられなかったので、Sheet2(確認画面)だけ添付致しました。
Sheet3(データ)では、一行に集約しています。
是非、ご教授お願いします。色々なお意見がききたいです。

教えてください。ド素人です。(参考書読み始めたところ)
聞き方も適切かわからないのですが、質問させてください。

Sheet1(入力画面)、Sheet2(確認画面)、Sheet3(データ)の3つのシートを作りました。

Sh1「入力画面」で入力された値は、関数で自動的に、Sh2「確認画面」指定のセルへコピーされるようにしています。
Sh1「入力画面」を入力し終えると。画面下のコマンドボタンで、Sh2「確認画面」へ画面が変わります。

そこで、内容を確認して、また、ここの下のコマンドボタンをクリックして...続きを読む

Aベストアンサー

私も、ど素人のマクロで、オマケにどんどん今は劣化中です。
ただ、今は、もう参考にする本もなくなってしまいました。

ご質問は、非常にわかりやすいです。

必ず、起点が2行目にあるとすれば、
i = sh3.Cells(Rows.Count, 2).End(xlUp).Row -1 '最後の次の行を探します。

そこに、Offsetで、ずらしていきます。

Sheets("データ").Range("B2:D2").Offset(i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
のようにして、全部、置換で、.Offset(i). を割りこませればよいでしょう。
検索:[).P] -> 置換:[).Offset(i).P]

以下で、添付したのは、マクロを集約してしまいました。
たぶん、私のコードは参考にはなりません。こんな考え方もあるのかなっていう程度にしてください。以下は、機械的に作られたものです。

'//--
Sub Test2Macro()
  Dim sh1 As Worksheet: Set sh1 = Worksheets("入力画面")
  Dim sh2 As Worksheet: Set sh2 = Worksheets("確認画面")
  Dim sh3 As Worksheet: Set sh3 = Worksheets("データ")
  Dim r1 As Range, a As Range
  Dim i As Long, j As Long, k As Long
  Dim Datas As Variant, c As Variant
  
  j = sh3.Cells(Rows.Count, 2).End(xlUp).Row + 1 '最後の行を探します。
  Set r1 = sh2.Range("C2:E2,C3:C5,C6:D9,C10:C14, C17")
  i = 2 '初期列
  For Each c In r1.Cells
    sh3.Cells(j, i).Value = c.Value
    i = i + 1
  Next c
  
  sh1.Range("D6:K6,D8:K8,D4:K4,D10:K10,D12:J12" & _
  ",D14:L14,L16,D16:J16,D18:J18,L18,L20" & _
  ",D20:J20,L22,D22:J22").ClearContents
  Datas = Array(90, 80, 5, 5)
  For Each a In sh1.Range("D26:H26,D28:H28,D30:H30,D32:H32").Areas
    a.Value = Datas(k)
    k = k + 1
  Next a
End Sub
'//--

私も、ど素人のマクロで、オマケにどんどん今は劣化中です。
ただ、今は、もう参考にする本もなくなってしまいました。

ご質問は、非常にわかりやすいです。

必ず、起点が2行目にあるとすれば、
i = sh3.Cells(Rows.Count, 2).End(xlUp).Row -1 '最後の次の行を探します。

そこに、Offsetで、ずらしていきます。

Sheets("データ").Range("B2:D2").Offset(i).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
のようにして、全部、置換で、.Offset(i). を割りこませればよいでしょう。...続きを読む


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

人気Q&Aランキング