VBA使用范围与可变范围并在条件下停止

Question

我想复制一系列表并将其粘贴到新的工作簿中。列A始终被复制。除此之外，我还要复制由其他列组成但可变的其他范围。例如，添加到列A中，我复制C和E列E。到目前为止，我成功地做了。我要添加的是最多5次，如果我完成了要复制的列，我会退出。更明确，有一个Exampel：我选择B，D，F列，而不是复制它们并将其粘贴到新的工作簿中。所以我三次停下来，复制我选择的东西并出去。

这是我的代码：

Sub Macro3()
Dim col1 As String, col2 As String, x As String, col3 As String, col4 As  String, col5 As String, col6 As String
Dim copyrange1 As Range, copyrange2 As Range, CopyRange3 As Range, CopyRange11 As Range, CopyRange4 As Range, CopyRange5 As Range
col1 = InputBox("first column, if finish write 'done'")
If col1 = "done" Then
        MsgBox ("copy finished")
    Else
    col1 = col1 & ":" & col1
    Set copyrange1 = Range(col1)
End If
col2 = InputBox("second column, if finish write 'done'")
If col2 = "done" Then
        MsgBox ("copy finished")
    Else
    col2 = col2 & ":" & col2
    Set copyrange2 = Range(col2)
End If
col3 = InputBox("third column, if finish write 'done'")
If col3 = "done" Then
        MsgBox ("copy finished")
    Else
    col3 = col3 & ":" & col3
    Set CopyRange3 = Range(col3)
End If
col4 = InputBox("fourth column, if finish write 'done'")
If col4 = "done" Then
        MsgBox ("copy finished")
    Else
    col4 = col4 & ":" & col4
    Set CopyRange4 = Range(col4)
End If
col5 = InputBox("fifth column, if finish write 'done'")
If col5 = "done" Then
        MsgBox ("copy finished")
    Else
    col5 = col5 & ":" & col5
    Set CopyRange5 = Range(col5)
End If
Set CopyRange11 = Union([A:A], copyrange1, copyrange2, CopyRange3, CopyRange4, CopyRange5)
CopyRange11.copy
Workbooks.Add
ActiveSheet.Paste
Windows("Pedro.xlsm").Activate
End Sub

如果我使用if循环，那就更好了。

非常感谢！

Answer 1

您可以像以下内容一样走：

Sub Macro3()
    Dim col As String, colsAddress As String
    Dim nCols As Integer
    col = Application.InputBox("column index (leave 'done' to finsih)", "Columns To copy", "done", , , , , 2)
    Do While col <> "done" And nCols < 5
        nCols = nCols + 1
        colsAddress = colsAddress & col & ":" & col & ","
        col = Application.InputBox("column index (leave 'done' to finsih)", "Columns To copy", "done", , , , , 2)
    Loop
    If colsAddress <> "" Then
        Intersect(ActiveSheet.UsedRange, Union([A:A], Range(Left(colsAddress, Len(colsAddress) - 1)))).Copy
        Workbooks.Add
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Windows("Pedro.xlsm").Activate
        MsgBox ("copy finished")
    End If
End Sub

Answer 2

尝试以下：

Option Explicit
Sub Macro3()
    Dim colLetter As String, doneString As String
    Dim copyRange As Range
    Set copyRange = [A:A]
    Dim i As Long
    For i = 1 To 5
        If Not doneString = "done" Then
            colLetter = InputBox("first column, if finish write 'done'")
            If colLetter = "done" Then
                doneString = colLetter
                MsgBox ("copy finished")
            Else
                colLetter = colLetter & ":" & colLetter
                Set copyRange = Union(copyRange, Range(colLetter))
            End If
        End If
    Next i
    copyRange.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Windows("Pedro.xlsm").Activate
End Sub

Answer 3

这将是我对此问题的解决方案

 Sub Macro3()
 Dim ColNum As Long
 Dim Col As String
 Dim CopyRange As Range
 Set CopyRange = [A:A]
 For i = 1 To 5
     Col = InputBox("Column number " & i & ", if finish write 'done'")
     If Col = "done" Then
         MsgBox ("copy finished")
         GoTo ExitIteration
     Else
         Set CopyRange = Union(CopyRange, Range(Col & ":" & Col))
     End If
 Next
 ExitIteration:
 CopyRange.Copy
 Workbooks.Add
 ActiveSheet.Paste
 Windows("Pedro.xlsm").Activate
 End Sub