指定した文字数を違うブックへ貼付けたい

質問

こんにちは。

マクロで下記作業をしたくて悩んでいます。

【Aブック　シートa　A列】
↓
A列の前6文字を
↓
【Bブック　シートb　B列】へ貼付け

A列が空欄になれば処理は終了

MIDを使って作っていたのですが、別ブックへの貼付けが組めません…。
検索をしても丁度参考になるものが見つけられませんでした。
詳しい方、ご教示頂けませんでしょうか？
よろしくお願いいたします。

回答No.1

tom04 · ベストアンサー

こんばんは！

Bブックが開いているかどうかによってコードが変わってきますが・・・
とりあえず開いていなくても対応できるようにしてみました。

Aブックの標準モジュールに↓のコードをコピー＆ペーストしてマクロを実行してみてください。
尚、Aブックの aシート　のA1セルからデータはあるという前提です。

Sub Sample1()
Dim i As Long, k As Integer, myPath As String, fN As String
Dim wS As Worksheet, myFlg As Boolean
myPath = "保存場所\"
fN = "B.xlsx"
Set wS = ThisWorkbook.Worksheets("a")
For k = 1 To Workbooks.Count
If Workbooks(k).Name = fN Then
myFlg = True
Exit For
End If
Next k
If myFlg = False Then
Workbooks.Open myPath & fN
End If
For i = 1 To wS.Cells(Rows.Count, "A").End(xlUp).Row
Workbooks(fN).Worksheets("b").Cells(i, "B") = Left(wS.Cells(i, "A"), 6)
If wS.Cells(i, "A") = "" Then Exit For
Next i
End Sub

※　コード内の「保存場所」の部分は、Bブックのプロパティの「場所」から確認して
フルパスを入力してください。

こんなんではどうでしょうか？m(_ _)m

お礼

ご回答ありがとうございます。
素晴らしい…。
想像していたよりも高度な感じでした。奥が深いですね；
業務にとても役立つので、応用しながら使わせていただきたいと思います。
ありがとうございました！m(_ _)m