Question

我不太擅长编码，所以尽可能多的帮助会令人难以置信。基本上这就是我想做的事。

从网站导出CSV（无需代码）
在Excel中打开CSV（无需代码）
自动删除某些列（已编码）
按特定顺序将特定列（忽略标题行）复制到另一个工作簿。

列顺序如下：（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")更改为您的实际源和目标工作簿和工作表

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

2 个答案: