VBA Utiliser la plage avec une variable et l'arrêter sous une condition

Question

Je souhaite copier une plage de tableau et la coller dans un nouveau classeur. Les colonnes A sont toujours copiées. En plus de cela, je veux copier d'autres plages composées d'autres colonnes mais comme variable. Par exemple, ajouté aux colonnes A, je copie les colonnes C et E. Jusqu'à présent, j'ai réussi à le faire. Ce que je veux ajouter est de procéder à ce maximum 5 fois et si je finis de sélectionner les colonnes à copier, je quitte. Pour être plus clair, il y a un exampel: Je sélectionne les colonnes B, D, F et copiez-les et collez-les dans un nouveau classeur. J'ai donc arrêté trois fois et copié ce que j'ai choisi et je sors.

ceci est mon code:

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 

Il whould beaucoup mieux si j'utilise une boucle Si.

Merci beaucoup!

Answer 1

vous pouvez aller comme suit:

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

Essayez ceci:

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

Ce serait ma solution à ce problème

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