使用VBA将特定的列从工作簿复制到另一个

debugcn 发表于 Dev

卢卡斯·穆里略（Lucas Murillo）

我需要编写宏的帮助，该宏将根据用户输入将数据从一个工作簿复制并粘贴到新工作簿。也就是说，宏应执行以下三项操作：

允许用户选择包含要复制到新工作簿中的数据的工作簿。
提示用户选择要复制到新工作簿中的数据列，最好仅使用列标题。
提示用户保存文件。

下面的代码允许用户选择工作簿并将打开的工作簿中的数据范围放入用户窗体，但是我不知道如何将所选内容从该用户窗体复制到新的工作簿中。该代码还以行显示工作簿中的数据，但是我只想要列标题的列表。

注意： “ multiColumnRange”是数据范围的定义名称，但这是“硬编码的”，我希望它是动态的。即，数据范围将根据工作簿而变化。

Sub Select_Workbook()

'Disables screen updating
Application.ScreenUpdating = False

'Defines the variable to hold the value of the file to open
Dim FileToOpen As Variant
'Defines the variable of the location of the file and the new workbook
Dim OpenBook As Workbook, NewBook As Workbook
     
Dim strCol As String

'Defines variable to hold value of table range
Dim rngMultiColumn As Range

 'Sets the variable to the file that is selected
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
'Checks if the user selected cancel and stores the Boolean value and not string
    If FileToOpen <> False Then
    Set OpenBook = Workbooks.Open(FileToOpen)
    
    'Define source range, referring to table's data range
    Set rngMultiColumn = OpenBook.Worksheets("Export").Range("multiColumnRange")
    
    With ufrmListBoxMultiColumn.lboxExampleMC
        .ColumnWidths = "120;120;120"
        .List = rngMultiColumn.Cells.Value
    End With
    
    ufrmListBoxMultiColumn.Show
    
    'Creates new workbook and assigns it to variable NewBook
    Set NewBook = Workbooks.Add

    End sub

气体

试试吧

Sub move_data()

Dim data_wb As Workbook
Dim target_wb As Workbook
Dim file_name As Variant
Dim header_range(100) As Range
Dim last_row As Long
Dim col_number As Long
Dim col_letter As String
Dim counter As Long
Dim quantity As Long

'select workbook
file_name = Application.GetOpenFilename(Title:="Choose a target Workbook")

If file_name <> False Then

    'create a new target workbook
    Set target_wb = Application.Workbooks.Add

    'open Workbook with the data
    Set data_wb = Application.Workbooks.Open(file_name)
    
    'get quantity to create loop
    quantity = _
    InputBox("How many columns do you want to copy?")
    
    'loop
    For counter = 1 To quantity
    
        'select header range
        Set header_range(counter) = _
        Application.InputBox("Select the HEADER of the " & counter & "º column you want to copy", Type:=8)
        
        'get last row and col letter
        col_number = header_range(counter).Column
        last_row = Cells(Rows.Count, col_number).End(xlUp).Row
        col_letter = Split(Cells(1, col_number).Address(True, False), "$")(0)

        'copy from data_wb
        Range(header_range(counter), Range(col_letter & last_row)).Copy
        
        'pastein target_wb
        target_wb.Sheets("Sheet1").Cells(1, counter).PasteSpecial
        
    Next counter
    
    data_wb.Close
    
    If Not target_wb.Saved Then
        If MsgBox("Do you want to save the file?", vbYesNo, "Save?") = vbYes Then
            target_wb.Save
        End If
    End If

End If

target_wb.Close

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。