選択した列をあるxlsから別の列にコピー/貼り付ける方法

Question

一部の列（常に同じ）をあるブックから別のブックにコピー/貼り付けしたいと思います。私はワークブックの間でこれを行うように私のコードを作ることはできません。 もう少し小さなものを4枚目のシートに貼り付け、自分でできるのは2枚目にペーストすることです：/

このコードのようなものは、同じxlsファイルの別のシートに貼り付けてください：

EDIT：xlsファイル間でコピー/貼り付けを試みました。うまくいかないのは、うまくいかないからです。

Sub Paste_columns() 

Dim x As Worksheet, r As Long, y As Worksheet 

Set x = Workbooks("Bench.xlsm").Worksheets("Test-Sheet") 
Set y = Workbooks("Pres.xls").Worksheets("Paste_tab") 
With y 
    For r = 2 To y.Range("B" & Rows.Count).End(xlUp).Row 
     If y.Cells(r, 2).Value > 0 Then 
     x.Range("B" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 2) 
     x.Range("C" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 3) 
     x.Range("D" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 4) 
     x.Range("E" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 5) 
     x.Range("H" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 8) 
     x.Range("I" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 9) 
     x.Range("M" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 13) 
     x.Range("O" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 15) 
     x.Range("Q" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 17) 
     x.Range("S" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 19) 
     x.Range("V" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 22) 
     x.Range("W" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 23) 
      Else: End 
     End If 

    Next r 

End With 
End Sub 

Answer 1

最後に、私はこのような何かをやってきたし、それが正常に動作します。 @おまけのお父さんのおかげで - 私はあなたのコードのいくつかを使用しました。私はそれがもっと普遍的かもしれないと思うが、私にとっては今はOKだ。

Sub PasteToTemplate() 

Dim xD As Workbook 
Dim xS As Workbook 
Dim wsSource As Worksheet 
Dim x As Worksheet 
Dim tempN As Worksheet 
Dim tN As String 
Dim sN As String 

With Sheets("Source_sample_size") 
    sN = .Range("PresName").Value 
End With 

Set xS = Workbooks(sN) 
Set wsSource = xS.Worksheets("Paste_tab") 

Set tempN = xS.Worksheets("Source_sample_size") 

With tempN 
    tN = .Range("tempName").Value 
    End With 

Set xD = Workbooks.Open(tN) 
Set x = xD.Worksheets("Test-Sheet") 


     wsSource.Range("A2:F" & wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row).Copy 
     x.Range("B4").PasteSpecial (xlPasteValues) 

     wsSource.Range("H2:I" & wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row).Copy 
     x.Range("H4").PasteSpecial (xlPasteValues) 

     wsSource.Range("J2:J" & wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row).Copy 
     x.Range("M4").PasteSpecial (xlPasteValues) 

     wsSource.Range("K2:K" & wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row).Copy 
     x.Range("O4").PasteSpecial (xlPasteValues) 

     wsSource.Range("L2:L" & wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row).Copy 
     x.Range("AI4").PasteSpecial (xlPasteValues) 

     wsSource.Range("M2:M" & wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row).Copy 
     x.Range("AK4").PasteSpecial (xlPasteValues) 

     wsSource.Range("P2:P" & wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row).Copy 
     x.Range("AM4").PasteSpecial (xlPasteValues) 



End Sub 

Answer 2

使用意味のある変数名 - あなたが学習している場合は特に：

Sub Example() 
Dim wbSource As Workbook 
Dim wbDestination As Workbook 
Dim wsSource As Worksheet 
Dim wsDestination As Worksheet 
Dim rSource As Range 
Dim rDestination As Range 
Set wbSource = Workbooks("Pres.xls") 
Set wsSource = wbSource.Worksheets("Paste_tab") 

Set wbDestination = Workbooks("Bench.xlsm") 
Set wsDestination = wbDestination.Worksheets("Test-Sheet") 

Set rSource = wsSource.Range("b2:b" & wsSource.Range("b" & wsSource.Rows.Count).End(xlUp).Row) 
For Each rDestination In wsDestination.Range("B4:W4") 
    If InStr("BCDEHIMOQSVW", Left(rDestination.AddressLocal(False, False), 1)) > 0 Then 

     ' rSource.Copy rDestination 
    '=============if only values wanted =========== 
     rsource.copy 
     rdestination.pastespecial xlpastevalues 
'================== 
    End If 
Next rDestination 
End Sub