教えて!gooにおける不適切な投稿への対応について

マクロを使って、ボタン一つで別ブックの表に転記を行いたいです。

下記添付画像は簡易的な表ですが、
「転記元シート」から別ブックの「転記先シート」へ、同じ色の部分のデータを転記したいと考えています。

元々下記コードを使って、一行丸々コピーして貼り付けをしていたのですが、
転記先シートの仕様上、丸々コピぺではなく、部分的にコピペして貼り付けたいです。

Range(Cells(), Cells()).Copy

Workbooks.Open FileName:= _
”転記先ブックのパス”

Dim Lastrow As Long
With ActiveSheet
Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(Lastrow + 1, 1).Select

ActiveCell.PasteSpecial Paste:=xlPasteValues


ActiveWorkbook.Save


End With

動作の流れとしては、
①転記元シートにある「転記ボタン」を押す
②各色と同じセルの内容がコピーされて、転記先シートに転記される
③転記先シートには自動で上の行から順番に転記されていく
このような流れをイメージしています。

できれば上記コードを少しいじる程度で解決できるのであればそうしていただけると助かります。

VBAは初心者で、上記コードもネットに載っていたものを使っている形です。

拙い説明で申し訳ございませんが、宜しくお願い致します。

「マクロの転記について教えてください」の質問画像

質問者からの補足コメント

  • 転記先シート画像

    「マクロの転記について教えてください」の補足画像1
      補足日時:2021/04/27 11:47
  • こんにちは。
    丁寧なご回答ありがとうございます。
    質問の内容が不十分で申し訳ございませんでした。
    以下にて補足させて頂きます。


    >②各色と同じセルの内容がコピーされて、転記先シートに転記される
    例ですと3色を分けて実行すると言う事でしょうか?
    例えば赤だけ、黄色と青色同時にとか、、すべてとか
    一行になっていますが、同じ色が複数行あると言う事もあるのでしょうか?

    →転記元のデータは一行のみとなります。
     毎回3色部分を同時に実行したいです。(1色のみだったり、2色のみだったりはありません)

    No.1の回答に寄せられた補足コメントです。 補足日時:2021/04/27 15:03
  • ③転記先シートには自動で上の行から順番に転記されていく
    コードですとA列を最終行取得する行にしていますが、
    色ごとにばらばらではないのでしょうか?
    A列は何かが必ず入力されるのでしょうか?

    →記載させて頂いたコードは元々、丸々1行をコピーして転記していた時に使用していたコードです。
     その時はA列の最終行を取得して、その行に丸々1行分転記していました。
     
     今回、3色の色を指定させて頂いたのは、丸々1行コピーして転記してしまうと、
     転記先のシートで使用したい関数が転記によって消されてしまうので、
     関数の入ったセル(画像でいうと、F列とI列(表だとE列とH列))を
     外した部分(3色の部分)をそれぞれ最終行を取得して転記したいです。
     (赤のデータならC列の最終行、青のデータならG列の最終行、黄のデータならJの最終行を
     取得するといった形です。)

      補足日時:2021/04/27 15:05
  • >Paste:=xlPasteValues
    になっていますが、書式のコピーは不要?なのでしょうか?

    →書式のコピーは不要です。

    >Range(Cells(), Cells()).Copy
    ここが分からないと言う事でしょうか?

    →こちらは、理解しております。

    以上補足となります。

    お手数ですが、ご確認お願い致します。

      補足日時:2021/04/27 15:05
  • 再度追記失礼致します。

    今回わかりやすくするためデータが入力してある部分に色(赤青黄)を入れておりますが、
    実際のデータには色はない状態です。
    あくまで転記元のデータと転記先のデータの識別のために色を使用しましたので、コードの中に色を指定する内容は不要です。

    逆にわかりづらいことになってしまい申し訳ございません。
    宜しくお願い致します。

      補足日時:2021/04/27 15:38
  • ご回答ありがとうございます。
    大変失礼ですが、質問内容を下記に変更させて頂けないでしょうか?

    Sub 一括貼り付け()
    Call 受注表貼付け1
    Call 受注表貼付け2
    Call 受注表貼付け3
    End Sub

    Sub 受注表貼付け1()
    Range(Cells(5, 18), Cells(5, 26)).Copy

    Workbooks.Open FileName:= _
    "転記先パス"

    Dim Lastrow As Long
    With ActiveSheet
    Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(Lastrow + 1, 1).Select

    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ActiveWorkbook.Save

    End With
    End Sub
    続く

    No.2の回答に寄せられた補足コメントです。 補足日時:2021/04/27 17:24
  • Sub 受注表貼付け2()
    Range(Cells(5, 28), Cells(5, 35)).Copy

    Workbooks.Open FileName:= _
    "転記先パス"

    Dim Lastrow As Long
    With ActiveSheet
    Lastrow = .Cells(Rows.Count, 11).End(xlUp).Row
    .Cells(Lastrow + 1, 1).Select

    ActiveCell.PasteSpecial Paste:=xlPasteValues

    ActiveWorkbook.Save


    End With

    End Sub

    続く

      補足日時:2021/04/27 17:26
  • Sub 受注表貼付け3()
    Range(Cells(5, 38), Cells(5, 43)).Copy

    Workbooks.Open FileName:= _
    "転記先パス"

    Dim Lastrow As Long
    With ActiveSheet
    Lastrow = .Cells(Rows.Count, 20).End(xlUp).Row
    .Cells(Lastrow + 1, 1).Select

    ActiveCell.PasteSpecial Paste:=xlPasteValues


    ActiveWorkbook.Save


    End With

    End Sub

      補足日時:2021/04/27 17:27
  • 上記のコードで、
    受注表貼付け1でコピーした内容を、転記先ブックのA列の最終行へ
    受注表貼付け2でコピーした内容を、転記先ブックのK列の最終行へ
    受注表貼付け3でコピーした内容を、転記先ブックのT列の最終行へ
    それぞれ転記をしたいです。

    上記コードを実行すると、転記先ブックのA列に全て転記されてしまい、
    受注表貼付け3の内容のみが残ってしまいます。

    受注表貼付け2で、Cells(Rows.Count, 11)、
    受注表貼付け3で、Cells(Rows.Count, 20)としているのですが、なぜK列とT列に転記されないのでしょうか?
    お手数ですが、宜しくお願い致します。

      補足日時:2021/04/27 17:27
gooドクター

A 回答 (3件)

.Cells(Lastrow + 1, 1).Select


ActiveCell.PasteSpecial Paste:=xlPasteValues
同じ列を選択してペーストしているからです。
.Cells(Lastrow + 1, ?).Select
?部分を直しましょう
    • good
    • 0

#1です


要は転記元シートの行番号を取得するコードですね。
#1はミスがありますので、下記を参考にしてみてください。

Sub Sample()
Dim WB As Workbook
Dim SH As Worksheet
Dim i As Long, Lastrow As Long
Set WB = ActiveWorkbook 'ThisWorkbook
Set SH = WB.Sheets("転記元シート")
'セルの色を上から調べて赤色の時の行ナンバーを取得
' For i = 1 To Sheets("転記元シート").Cells(Rows.Count, "B").End(xlUp).Row
' If Sheets("転記元シート").Cells(i, "B").DisplayFormat.Interior.ColorIndex = 3 Then
' Exit For
' End If
' Next
'------
'B列の最終行を転記する場合
' For i = 1 To Sheets("転記元シート").Cells(Rows.Count, "B").End(xlUp).Row
'---
'選択しているセル(アクティブセルの行№)
i = ActiveCell.Row

Application.ScreenUpdating = False
Workbooks.Open Filename:="転記先ブックパス"
With ActiveSheet '転記先ブックのアクティブシート
Lastrow = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Cells(Lastrow, "B").Resize(, 3).Value = SH.Cells(i, "B").Resize(, 3).Value
.Cells(Lastrow, "F").Resize(, 2).Value = SH.Cells(i, "B").Resize(, 2).Value
.Cells(Lastrow, "I").Resize(, 2).Value = SH.Cells(i, "I").Resize(, 2).Value
End With
ActiveWorkbook.Close SaveChanges:=True
Application.ScreenUpdating = True
Set SH = Nothing
Set WB = Nothing
End Sub

転記元シートの最終行はB列を対象にしています。
コメントアウトしているのは、上がセルの色で取得
2番目のコメントがB列の最終行

コメントにしていない 
i = ActiveCell.Row はアクティブなセルの行番号です

移したい行を選択してボタンを押すとその行の決められた列が転記先シートの新規行に出力されます。

注意
With ActiveSheet '転記先ブックのアクティブシート  になっていますが
開いた転記先ブックの転記先シートが必ずアクティブになっている保証はありませんので、Sheets("転記先シート").Activate のように入れ、さらにシートが存在しない時のエラー処理を入れた方が良いと思います。

ご不明な点がありましたら補足でお願いします。
この回答への補足あり
    • good
    • 0

こんにちは、



少しご質問で判らない所があります。

>①転記元シートにある「転記ボタン」を押す
OK
>②各色と同じセルの内容がコピーされて、転記先シートに転記される
例ですと3色を分けて実行すると言う事でしょうか?
例えば赤だけ、黄色と青色同時にとか、、すべてとか
一行になっていますが、同じ色が複数行あると言う事もあるのでしょうか?

③転記先シートには自動で上の行から順番に転記されていく
コードですとA列を最終行取得する行にしていますが、
色ごとにばらばらではないのでしょうか?
A列は何かが必ず入力されるのでしょうか?

>Paste:=xlPasteValues
になっていますが、書式のコピーは不要?なのでしょうか?

>Range(Cells(), Cells()).Copy
ここが分からないと言う事でしょうか?
飛んでいるセルなので分けて

Range(Cells(i, "B"), Cells(i, "D"))
Range(Cells(i, "F"), Cells(i, "G"))
Range(Cells(i, "I"), Cells(i, "J"))

xlPasteValuesなのでコピーでなく代入(参照)式で書く場合。

Sub a()
Dim WB As Workbook
Dim i As Long
Set WB = ActiveWorkbook
For i = 1 To Sheets("転記元シート").Cells(Rows.Count, "B").End(xlUp).Row
If Sheets("転記元シート").Cells(i, "B").DisplayFormat.Interior.ColorIndex = 3 Then
Exit For
End If
Next
Workbooks.Open Filename:= _
"転記先ブックのパス"
Dim Lastrow As Long
With ActiveSheet
Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row

.Range(Cells(Lastrow, "B"), Cells(Lastrow, "D")).Value = _
WB.Sheets("転記元シート").Range(Cells(i, "B"), Cells(i, "D")).Value
.Range(Cells(Lastrow, "F"), Cells(Lastrow, "G")).Value = _
WB.Sheets("転記元シート").Range(Cells(i, "F"), Cells(i, "G")).Value
.Range(Cells(Lastrow, "I"), Cells(Lastrow, "J")).Value = _
WB.Sheets("転記元シート").Range(Cells(i, "I"), Cells(i, "J")).Value

ActiveWorkbook.Close SaveChanges:=True
End With

WBはVBA実行ブック
iは変数 転記元シートの対象セル色で分岐して行№を取得し代入します。
とりあえず。
この回答への補足あり
    • good
    • 0

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

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

gooドクター

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

人気Q&Aランキング