Question

我想复制一系列表格并将其粘贴到新工作簿中。始终复制列A.除此之外，我想复制其他列组成的其他范围，但作为变量。例如，添加到列A，我复制列C和E.直到现在我已经成功完成了。我要添加的是最多5次，如果我选择要复制的列，我退出。更清楚的是，有一个例子：我选择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

试试这个：

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 2

你可以如下：

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 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

VBA使用带变量的范围并在条件下将其停止

3 个答案: