Question

我有一个excel文件，我所做的是将每个列标题添加到列表框中作为项目。现在，我想要实现的是当我在列表框中选择多个项目时，它将复制相应的列并将其粘贴到另一个工作簿。

我现在有这个代码，它只能复制并粘贴我从列表框中选择的第一列。我希望有人可以帮助我。

Private Sub CommandButton1_Click() ' generate result

Dim wkb As Workbook
Dim rng As Range
Dim cl As Object
Dim strMatch As String
Dim Size As Integer
Dim lRow As Long, lCol As Long
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range

Set rng1 = Cells.Find("*", [a1], xlFormulas, , xlByRows, xlPrevious)
Set rng2 = Cells.Find("*", [a1], xlFormulas, , xlByColumns, xlPrevious)
Set rng3 = Range([a1], Cells(rng1.Row, rng2.Column))

strMatch = ListBox2.List(0) 'Copying Respondent Number
Set rng = Range("A1:Z1")
For Each cl In rng
    If cl.Value = strMatch Then
        cl.EntireColumn.Copy 'Copy Selected Column
        Set wkb = Workbooks.Add 'Adding New Workbook
        ActiveSheet.Paste 'Paste Selected Column
        Exit For
    End If
Next cl

End Sub

Answer 1

建议更正。这将为每个选定的列创建1个工作簿。

Private Sub CommandButton1_Click() ' generate result
Dim rng As Range
Dim cl As Object
Dim strMatch As String
Dim , i As Integer
Dim  lCol As Long
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 0 To ListBox1.ListCount - 1
 strMatch = ListBox1.List(i) 'Copying Respondent Number
 Set rng = Range(Cells(1, 1), Cells(1, lCol))
 Set cl = rng.Find(strMatch, lookat:=xlWhole)
 If Not cl Is Nothing Then
        cl.EntireColumn.Copy 'Copy Selected Column
        Set wkb = Workbooks.Add 'Adding New Workbook
        ActiveSheet.Paste 'Paste Selected Column
 End If
Next i
End Sub

Answer 2

你可以试试这个

Option Explicit

Private Sub CommandButton1_Click()
    Dim i As Long
    Dim colsIndexStrng As String
    Dim copyRng As Range

    With Me.ListBox2
        For i = 0 To .ListCount - 1
            If .selected(i) Then colsIndexStrng = colsIndexStrng & Cells(1, i + 1).Address(False, False) & ","
        Next i
    End With

    If colsIndexStrng = "" Then Exit Sub

    Set copyRng = Range(Left(colsIndexStrng, Len(colsIndexStrng) - 1)).EntireColumn
    With Workbooks.Add
        copyRng.Copy ActiveSheet.Range("A1")
    End With
    ActiveWorkbook.Close True
End Sub

VBA宏 - 使用ListBox在Excel中动态选择列

2 个答案: