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

Question

I'm not really great at coding so as much help as possible would be incredible. Basically here's what I want to do.

1. Export CSV from Website (No code required)
2. Open CSV in Excel (No code required)
3. Automatically remove rows that have a blank cell in certain column (Already coded)
4. Copy specific columns (ignoring header rows) to another workbook in specific order.

Column order is as follows: (S1 = Open CSV || S2 = New Workbook)

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

Step 3's code:

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

Answer 1

There is a lot to consider when doing what you require, I have made some assumptions that you will need to code for if they are incorrect: -

• The destination already exists
• The destination has headers on row 1 but no content
• The destination is simply the first sheet in the destination workbook
• The source header row is row 1

Sample code: -

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

I have also assumed the source to be the workbook I was coding in, this won't be possible in a CSV file so you might want to open it in the same way the destination is checked for and then opened, you also may want to add a flag to close them when done if they were not opened to begin with.

Finally, if the destination already has data use the .end function as shown in the sample to get the the last row.

Answer 2

since you're working from CSV file, you don't have formats to carry along

therefore simple values pasting is what you need

try this

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

which you can exploit as follows

Option Explicit

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

just change ActiveWorkbook.ActiveSheet and Workbooks("columntest").Worksheets("test") to your actual source and target workbooks and worksheets