Excel VBA：将列从工作簿复制到新工作簿

Question

我不是很擅长编码，所以尽可能多的帮助将是不可思议的。 基本上，这就是我想要做的。

1. 从网站导出CSV（无需代码）
2. 在Excel中打开CSV（无需代码）
3. 自动删除某些列中具有空白单元格的行（已编码）
4. 按特定顺序将特定列（忽略标题行）复制到另一个工作簿。

列顺序如下：（S1 =打开CSV || S2 =新工作簿）

• S1.V = S2.A
• S1.B = S2.D
• S1.F = S2.V
• S1.H = S2.X
• S1.I = S2.J
• S1.L = S2.B

步骤3的代码：

Columns("V:V").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete

Answer 1

在做您需要做的事情时，有很多要考虑的地方，我做了一些假设，如果它们不正确，则需要进行编码：-

• 目标已经存在
• 目标行1上有标头，但没有内容
• 目标只是目标工作簿中的第一张表
• 源头行是第1行

示例代码：-

Public Sub Sample()
Dim StrDestPath As String
Dim WkBk_Dest   As Workbook
Dim WkBk_Src    As Workbook
Dim WkSht_Dest  As Worksheet
Dim WkSht_Src   As Worksheet

'A reference to the destination
StrDestPath = "C:\Users\Gary\Desktop\Destination.xlsx"

'Connect to the source
Set WkBk_Src = ThisWorkbook
Set WkSht_Src = WkBk_Src.Worksheets(1)

'See if the destination is open already
For Each WkBk_Dest In Application.Workbooks
    If WkBk_Dest.FullName = StrDestPath Then Exit For
Next

'If it wasn't then open it
If WkBk_Dest Is Nothing Then
    Set WkBk_Dest = Application.Workbooks.Open(StrDestPath)
End If

'Connect to the destination
Set WkSht_Dest = WkBk_Dest.Worksheets(1)

'Per column mapping - Copy everythng from row 2 (assuming headers are on row 1 down to the last populated cell in that column
'and paste it into the required column in the destination
WkSht_Src.Range("V2:" & WkSht_Src.Range("V2").End(xlDown).Address).Copy WkSht_Dest.Range("A2")
WkSht_Src.Range("B2:" & WkSht_Src.Range("B2").End(xlDown).Address).Copy WkSht_Dest.Range("D2")
WkSht_Src.Range("F2:" & WkSht_Src.Range("F2").End(xlDown).Address).Copy WkSht_Dest.Range("V2")
WkSht_Src.Range("H2:" & WkSht_Src.Range("H2").End(xlDown).Address).Copy WkSht_Dest.Range("X2")
WkSht_Src.Range("I2:" & WkSht_Src.Range("I2").End(xlDown).Address).Copy WkSht_Dest.Range("J2")
WkSht_Src.Range("L2:" & WkSht_Src.Range("L2").End(xlDown).Address).Copy WkSht_Dest.Range("B2")

'Disconnect from destination worksheet
Set WkSht_Dest = Nothing

'save changes
WkBk_Dest.Save

'disconnect from destination workbook
Set WkBk_Dest = Nothing

'Disconnect from source
Set WkSht_Src = Nothing
Set WkBk_Src = Nothing

End Sub

我还假设源是我正在编码的工作簿，因此在CSV文件中将无法实现，因此您可能希望以检查目标然后打开目标的方式打开它，您可能还想如果开始时未打开它们，请添加一个标志以在完成后将其关闭。

最后，如果目的地已经有数据，请使用如示例中所示的.end函数来获取最后一行。

Answer 2

由于您使用的是CSV文件，因此没有可携带的格式

因此，您需要简单的值粘贴

尝试这个

Option Explicit
Sub CopyColumnsToAnotherWB(sourceWS As Worksheet, targetWs As Worksheet, sourceCols As String, targetCols As String)
    Dim sourceColsArr As Variant, targetColsArr As Variant
    Dim iCol As Long, nCols As Long

    sourceColsArr = Split(Application.WorksheetFunction.Trim(sourceCols), ",") '<--| make array out of string with delimiter
    targetColsArr = Split(Application.WorksheetFunction.Trim(targetCols), ",") '<--| make array out of string with delimiter

    nCols = UBound(sourceColsArr) '<--| count columns number to copy/paste
    If nCols <> UBound(targetColsArr) Then Exit Sub  '<--| exit if the two columns list haven't the same number of columns
    With sourceWS
        For iCol = 0 To nCols '<--|loop through source sheet columns
            With .Cells(1, sourceColsArr(iCol)).Resize(.Cells(.Rows.Count, sourceColsArr(iCol)).End(xlUp).Row)
                targetWs.Columns(targetColsArr(iCol)).Resize(.Rows.Count).value = .value  '<--|paste values to corresponding target sheet column
            End With
        Next iCol
    End With
End Sub

您可以如下利用

显式期权

Sub main()

    Dim sourceCols As String, targetCols As String

    sourceCols = "V,B,F,H,I,L"
    targetCols = "A,D,V,X,J,B"
    CopyColumnsToAnotherWB ActiveWorkbook.ActiveSheet, Workbooks("columntest").Worksheets("test"), sourceCols, targetCols

End Sub

只需将ActiveWorkbook.ActiveSheet和Workbooks("columntest").Worksheets("test")更改为实际的源和目标工作簿和工作表