ここから本文です

VBAの質問です。

アバター

ID非公開さん

2018/8/2714:17:58

VBAの質問です。

コピー元と同じ行数(B3・C3列以降)のデータを
別データの別シート(A2・B2列以降)に張り付けたあと、

別データの別シート内のC2・D2行目に記載してある文言を
A・Bに張り付けた同じ行数までコピーさせるコードをご教示いただけますと幸いです。

添付画像は、貼り付け先の別データの状況です。


----------------------
Sub Macro01()

Dim ws As Worksheet
Dim lastRow As Long
Dim wb As Workbook
'
Set ws = Sheets("シートA")
lastRow = ws.Range("B" & Rows.Count).End(xlUp).Row

Set wb = Workbooks.Open("C:~~\データB.xlsx)
ws.Range("B3:C" & lastRow).Copy Sheets("シートB").Range("A2")

wb.SaveAs "C:~~" & ws.Range("P11").Value

wb.Close False
End Sub

ws.Range,wb.Close False,Sub Macro01,Workbooks.Open,Rows.Count

この質問は、活躍中のチエリアン・専門家に回答をリクエストしました。

閲覧数:
41
回答数:
1
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

ina********さん

2018/8/3009:55:15

>A・Bに張り付けた同じ行数までコピーさせるコード

こんな感じでいかがでしょうか。


Sub Macro01()
    Dim Ws As Worksheet
    Dim rngS As Range 'コピー元セル範囲
    Dim Wb As Workbook
    Dim rngD As Range '貼り付け先セル
    
    'コピー元
    Set Ws = Sheets("シートA")
    With Ws
        Set rngS = .Range("B3", .Range("B" & Rows.Count).End(xlUp))
        Set rngS = rngS.Resize(, 2)
    End With
    
    '貼り付け先
    Set Wb = Workbooks.Open("C:~~\データB.xlsx")
    Set rngD = Wb.Sheets("シートB").Range("A2")
    
    'コピペ
    rngS.Copy rngD
    
    'C列D列を下へコピペ
    With rngD.Offset(, 2).Resize(, 2)
        .Copy .Offset(1).Resize(rngS.Rows.Count)
    End With
    
    Wb.SaveAs "C:~~" & Ws.Range("P11").Value
    
    Wb.Close False
End Sub

アバター

質問した人からのコメント

2018/8/30 14:08:31

冒頭のカラム行も含めてコピーされていたので、「-1」したらうまくいきました!
ご教示いただきありがとうございますmm

'C列D列を下へコピペ
With rngD.Offset(, 2).Resize(, 2)
.Copy .Offset(1).Resize(rngS.Rows.Count - 1)

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる