ループ中にコピーする異なる範囲を循環する

Question

これは私の現在のコードです。

Sub Loops() 

    Dim MyPath As String 
    Dim MyFileName As String 
    Dim output As Variant 
    Dim outputRange(1 To 3) As Range 

    Set outputRange(1) = Worksheets("vbaTest").Range("output1", Worksheets("vbaTest").Range("output1").End(xlDown)) 
    Set outputRange(2) = Worksheets("vbaTest").Range("output2", Worksheets("vbaTest").Range("output2").End(xlDown)) 
    Set outputRange(3) = Worksheets("vbaTest").Range("output3", Worksheets("vbaTest").Range("output3").End(xlDown)) 

For Each output In outputRange 

    'The path and file names: 
    MyPath = "C:\Users\x\Custom Office Templates" 
    MyFileName = "Test" 
    'Makes sure the path name ends with "\": 
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\" 
    'Makes sure the filename ends with ".csv" 
    If Not Right(MyFileName, 4) = ".txt" Then MyFileName = MyFileName & ".txt" 
    'Copies the sheet to a new workbook: 
    Sheets("vbaTest").Range("**output1**").Copy 
    'The new workbook becomes Activeworkbook: 
    Workbooks.Add 
    ActiveSheet.Columns("A").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
    With ActiveWorkbook 
     Application.DisplayAlerts = False 

End With 

'Brings back original sheet 
Workbooks("vbaTest.csv").Activate 
'Starts at the top of code 
Next output 

End Sub 

出力1のときに私が設定したさまざまな範囲でループしています。 "シート（" vbaTest "）。範囲（" 出力1 "）。コピー"

私が設定した3つの出力をループするようにしようとしています。助言がありますか？

Answer 1

：ここ

は少し微調整コードです

Option Explicit 

Sub Loops() 
    Dim MyPath As String 
    Dim MyFileName As String 
    Dim output As Variant 
    Dim outputRange(1 To 3) As Range 


    With Worksheets("vbaTest") '<--| reference your worksheet once and for all! 
     Set outputRange(1) = .Range("output1", .Range("output1").End(xlDown)) '<--| all "dotted" reference implicitly assume the object after preceeding 'With' keyword as the parent one 
     Set outputRange(2) = .Range("output2", .Range("output2").End(xlDown)) 
     Set outputRange(3) = .Range("output3", .Range("output3").End(xlDown)) 
    End With 

    For Each output In outputRange 
     Workbooks.Add.Worksheets(1).Range("A1").Resize(output.Rows.Count).Value = output.Value 
    Next output 

' the following code doesn't currently depend on looping variable 
' so I put it outside the loop-> I guess you're setting the new workbooks names 

    'The path and file names: 
    MyPath = "C:\Users\x\Custom Office Templates" 
    MyFileName = "Test" 
    'Makes sure the path name ends with "\": 
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\" 
    'Makes sure the filename ends with ".csv" 
    If Not Right(MyFileName, 4) = ".txt" Then MyFileName = MyFileName & ".txt" 


End Sub 

Answer 2

このサイトにはSelectを避けるための記事がたくさんありますが、値が必要な場合はCopy/Pasteも避けることができます。プログラミングの効率を助けるためにそれらを読む価値があるかもしれません。

ループに関しては、For i = 1 to nスタイルループを使用して配列のインデックスを反復する方が簡単かもしれません。これにより、For Each ...スタイルループで必要なVariantではなく、Rangeとしてオブジェクトを参照することができます。

はすべて一緒に、あなたのコードのループ要素はに単純化することができます任意の追加の変更がなければ

'Add these declarations 
Dim wb As Workbook 
Dim i As Long 

For i = LBound(outputs) To UBound(outputs) 
    '... 
    Set wb = Workbooks.Add 
    wb.Worksheets(1).Range("A1") _ 
     .Resize(outputs(i).Rows.Count, outputs(i).Columns.Count) _ 
     .Value = outputs(i).Value2 
Next 

Answer 3

、あなただけSheets("vbaTest").Range(output.address).Copyにその行を変更する必要があります。

しかし、.Copyの使用方法に注意し、特別な値を貼り付けますか？代わりに、2つの範囲を等しく設定できます。また、ワークブック/ワークシート変数を使用して、それらをまっすぐに保つ必要があります。あなたがダウン短縮でき

Sub Loops() 

    Dim MyPath As String, MyFileName As String 
    Dim output As Variant 
    Dim outputRange(1 To 3) As Range 
    Dim newWB As Workbook 
    Dim newWS As Worksheet, mainWS As Worksheet 

    Set mainWS = Worksheets("vbaTest") 

    With mainWS 
     Set outputRange(1) = .Range("output1", .Range("output1").End(xlDown)) 
     Set outputRange(2) = .Range("output2", .Range("output2").End(xlDown)) 
     Set outputRange(3) = .Range("output3", .Range("output3").End(xlDown)) 
    End With 

For Each output In outputRange 
    Debug.Print output.Address 
    'The path and file names: 
    MyPath = "C:\Users\x\Custom Office Templates" 
    MyFileName = "Test" 
    'Makes sure the path name ends with "\": 
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\" 
    'Makes sure the filename ends with ".csv" 
    If Not Right(MyFileName, 4) = ".txt" Then MyFileName = MyFileName & ".txt" 

    'The new workbook becomes Activeworkbook: 
    Set newWB = Workbooks.Add 
    Set newWS = newWB.ActiveSheet 

    'Instead of .Copy/.PasteSpecial Values (meaning, you just want the text), we can 
    ' skip the clipboard completely and just set the two ranges equal to eachother: 
    ' Range([destination]).Value = Range([copy range]).Value 
    newWS.Columns("A").Value = mainWS.Range(output.Address).Value 
    With newWB 
     Application.DisplayAlerts = False 
    End With 

'Brings back original sheet 
mainWS.Activate 
'Starts at the top of code 
Next output 

End Sub 

Answer 4

私はそれ以上のユーザーから受け取った答えは、私はそれがしたい方法は以下の通りです作品：

シート（ "vbaTest"）範囲（output.address）.Copy