電子書籍の厳選無料作品が豊富!

質問の内容なのですが、ファイルA.xlsのファイルの中にtestAというシートがあったとします。

A(列)B

・赤組
田中○○
鈴木××
高橋△△

・青組
田代○○
鈴木△△
広瀬××

・白組
三浦××
橋本○○
鈴木△△

上記のようになっている状態で赤組の「鈴木」に該当するセル内の文字列を別のファイルである
ファイルB.xlsのtestBというシートの任意のセル(仮にD7とします)に貼り付けることは可能なのでしょうか?

よろしくお願い致します。

A 回答 (3件)

こんにちは。



その質問だけですと、マクロとしてはひどく面倒な気がします。

>赤組の「鈴木」に該当
ということは、まず、「赤組」を探して、次に、「鈴木」を探す、ということではないでしょうか?

参考まで。

Sub Test1()
  Dim wb1 As Workbook
  Dim wb2 As Workbook
  Dim i As Long
  Dim j As Long
  Dim find1 As String
  Dim find2 As String
  Dim flg As Boolean
  find1 = "・赤組"
  find2 = "鈴木"
  
  Set wb1 = Workbooks("A.xls")
  Set wb2 = Workbooks("B.xls")
  
  'コピー先の行数の決定
  j = wb2.Worksheets("testB").Range("D65536").End(xlUp).Row
  If j < 7 Then
    j = 7
  Else
    j = j + 1
  End If
  
  flg = False
  With wb1.Worksheets("testA")
    For i = 1 To .Range("A65536").End(xlUp).Row
      If .Cells(i, 1).Value Like "*" & find1 & "*" Then
        flg = True
      ElseIf .Cells(i, 1).Value Like "・*" Then  '組名には中黒点(・)が入っていること
        flg = False
        Exit For
      End If
      '今回は、鈴木と××をコピー、××だけなら、以下は、
      'wb2.Worksheets("Sheet1").Cells(j, 4).Value _
      '= Cells(i, 1).Offset(,1).Value
      If .Cells(i, 1).Value Like "*" & find2 & "*" And flg Then
         wb2.Worksheets("Sheet1").Cells(j, 4).Resize(, 2).Value _
        = .Cells(i, 1).Resize(, 2).Value
        j = j + 1
      End If
    Next i
  End With
  Set wb1 = Nothing
  Set wb2 = Nothing
End Sub
    • good
    • 0

補足訂正です。

今回の場合

Range("B2").Select → Worksheets("testA").Range("B2").Select

Range("D7").Select → Worksheets("testB").Range("D7").Select

としなければならないかな。
    • good
    • 0

関数(というか演算子=ですが)ではなく、値を張り付けたいのですね。


簡単にできますよ。

Sub Macro1()
'
Range("B2").Select
Selection.Copy
Windows("Book2").Activate
Range("D7").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub

のような感じです。Book1、Book2ともに開いている必要があります。
    • good
    • 0

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