VBA代码优化：多列数据转指定工作簿对应列并实现关闭功能

Hey there! Your current code is doing a lot of unnecessary work—opening the same workbook 7 times in a row is not only inefficient but also error-prone. Let's fix that and add the missing close functionality.

Key Issues in Your Original Code #

• You repeatedly open MyData.xlsx for every column transfer, which slows down execution and risks file lock issues
• Duplicate object declarations (Set myWs, Set MyData, etc.) for each copy operation
• No logic to close the target workbook after completing the transfer

Optimized Solution #

Here's a cleaned-up version that handles all column transfers in one go, with proper workbook closing:

Sub transfer()
    Dim MyData As Workbook
    Dim DataWs As Worksheet
    Dim myWs As Worksheet
    Dim columnMappings As Variant
    Dim i As Integer
    
    ' Set up source worksheet once
    Set myWs = ThisWorkbook.Sheets("FinalinputFile")
    
    ' Open target workbook ONCE (no need to re-open it every time!)
    Set MyData = Workbooks.Open("D:\Desktop\My\MyData.xlsx")
    Set DataWs = MyData.Sheets("Data")
    
    ' Define your source -> target column mappings in an array
    ' Format: {Source Range, Target Start Cell}
    columnMappings = Array( _
        Array("C3:C11000", "E2"), _
        Array("E3:E11000", "F2"), _
        Array("G3:G11000", "G2"), _
        Array("I3:I11000", "H2"), _
        Array("K3:K11000", "I2"), _
        Array("M3:M11000", "J2"), _
        Array("U3:U11000", "M2") _
    )
    
    ' Loop through each mapping to copy/paste data
    For i = LBound(columnMappings) To UBound(columnMappings)
        myWs.Range(columnMappings(i)(0)).Copy
        DataWs.Range(columnMappings(i)(1)).PasteSpecial xlPasteAll
    Next i
    
    ' Clean up clipboard to remove "marching ants" selection
    Application.CutCopyMode = False
    
    ' Save changes and close the target workbook
    MyData.Save
    MyData.Close SaveChanges:=False ' We already saved, so this is safe
    
    ' Release object variables (good practice to free memory)
    Set DataWs = Nothing
    Set MyData = Nothing
    Set myWs = Nothing
End Sub

What This Does #

1. Single Workbook Open: We only open MyData.xlsx once at the start, which cuts down on unnecessary file operations and speeds up execution
2. Array Mappings: All column pairs are stored in an array, so we can loop through them instead of writing identical code 7 times
3. Proper Closing: MyData.Close closes the workbook after saving. We set SaveChanges:=False here because we already called MyData.Save, but you could skip the separate Save call and just use MyData.Close SaveChanges:=True if you prefer a more concise approach
4. Clipboard Cleanup: Application.CutCopyMode = False clears the clipboard and removes the annoying selection border from your sheet
5. Object Cleanup: Setting objects to Nothing helps free up system resources, which is a good habit for longer VBA procedures

Bonus Tip #

If you want to avoid copying empty rows, replace the hardcoded 11000 with a dynamic last row calculation. For example:

' Get last row with data in column C (adjust column letter as needed)
Dim lastRow As Long
lastRow = myWs.Cells(myWs.Rows.Count, "C").End(xlUp).Row
' Then use ranges like myWs.Range("C3:C" & lastRow) instead of "C3:C11000"

内容的提问来源于stack exchange，提问作者taco bell