複製選擇性列數據直到第1列中的數據結束

Question

我目前使用以下代碼將粘貼數據從文件 - 「源」複製到文件 - 「目標」。直到數據在Column-1中結束爲止。然而，目前選擇A至AE的所有列，但是相反，我希望選擇諸如A，F，K，AA的選擇性列。 我知道「wb.ActiveSheet.Range（」A2：AE「& N）.Copy」中的代碼需要更改，但不確定語法。 任何人都可以幫助我嗎？提前感謝幫助。

Dim wb As Workbook 
Set wb = ActiveWorkbook 

Dim N As Long 
Dim LastRow As Long 
N = Cells(2, 1).End(xlDown).Row 
wb.ActiveSheet.Range("A2:AE" & N).Copy 

Set y = Workbooks.Open("C:\Desktop\Destination.xlsx") 

y.Activate 
y.Sheets("Data").Select 
y.Sheets("Data").Activate 


For Each Cell In y.Sheets("Data").Columns(1).Cells 
    If Len(Cell) = 0 Then Cell.Select: Exit For 
Next Cell 
Selection.PasteSpecial Paste:=xlPasteValues 
Application.DisplayAlerts = False 
ActiveWorkbook.Close True 
Application.DisplayAlerts = True 
Application.CutCopyMode = False 

Answer 1

可以使用Application.Union來合併範圍從不同的列（第2行，直到N）。

此外，您可以使用LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1來代替循環查找空的以找到空的Cell。

我添加了2個With wb.Sheets("Sheet1")以完全限定所有變量和嵌套在下面的Range。

代碼

Option Explicit 

Sub CopyColumns() 

Dim wb  As Workbook 
Dim Y  As Workbook 
Dim N  As Long 
Dim LastRow As Long 
Dim CopyRng As range 

Application.DisplayAlerts = False 
Application.ScreenUpdating = False 

Set wb = ActiveWorkbook 

' you need to specify the sheet, otherwise it will take the Active Sheet 
With wb.Sheets("Sheet1") ' <-- modify to your sheet's name 
    N = .Cells(.Rows.Count, "A").End(xlUp).Row ' <-- get last row from Column "A", skips blank cells in te middle 
    ' set the range to Columns A, F, K, AA 
    Set CopyRng = Application.Union(.Range("A2:A" & N), .Range("F2:F" & N), .Range("K2:K" & N), .Range("AA2:AA" & N)) 
End With 

Set Y = Workbooks.Open("C:\Desktop\Destination.xlsx")  
With Y.Sheets("Data") 
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 '<-- get first empty row at Column A to paste at 
    CopyRng.Copy 
    .Range("A" & LastRow).PasteSpecial xlPasteValues 
End With  
Y.Close True 

Application.DisplayAlerts = True 
Application.ScreenUpdating = True 
Application.CutCopyMode = False 

End Sub