循環錯誤地粘貼在具有數據的列上

Question

底部的代碼將列從一個表單複製到另一個表單，並逐個將文本複製到列。例如，在處理了A列之後，列B（第一張）的文本到列過程應該從第二張表中的下一個可用空列開始。

第一張表中的行具有不同的長度。因此，列A可能有單元格A1：A25已滿，但列N可能只有一些單元格已滿，因爲某些行已結束。

此代碼正常工作，直到它遇到第一個部分滿的列，然後它將列粘貼到同一列。

我認爲下面的線將照顧這，但它似乎並沒有工作：

If Application.WorksheetFunction.CountA(Excel.Sheets("Organise_R").Columns(b)) > 0 Then b = b + 1 

我一直試圖在過去的幾個小時，但我已經沒有success.Any幫助將不勝感激！提前致謝！

For a = 1 To 60 

'If Excel.WorksheetFunction.CountBlank(Excel.Sheets("Import_R").Columns(a)) < 1048576 
If Application.WorksheetFunction.CountA(Excel.Sheets("Import_R").Columns(a)) > 0 Then 

    Excel.Sheets("Import_R").Columns(a).Copy 

    b = Excel.Sheets("Organise_R").Cells(1, Columns.Count).End(Excel.xlToLeft).column 

    Excel.Sheets("Organise_R").Select 

    'If Cells(1, b) <> "" 
    'If Excel.WorksheetFunction.CountBlank(Excel.Sheets("Organise_R").Columns(b)) < 1048576 Then 
    If Application.WorksheetFunction.CountA(Excel.Sheets("Organise_R").Columns(b)) > 0 Then b = b + 1 


     Excel.Sheets("Organise_R").Columns(b).EntireColumn.Select 
     Excel.ActiveSheet.Paste 

     Excel.Application.CutCopyMode = False 
     Selection.TextToColumns Destination:=Cells(1, b), DataType:=xlDelimited, _ 
       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ 
       Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ 
       :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ 
       Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True 

End If 



Next a 

Answer 1

這不是我會怎麼做 - 特別是，我不明白你的代碼行：

If Application.WorksheetFunction.CountA(Excel.Sheets("Organise_R").Columns(b)) > 0 Then b = b + 1 

因爲我owuld假設你owuld需要一個循環這裏找到最後一列，但這是另一回事。

b = Excel.Sheets("Organise_R").UsedRange.Columns.Count 

要更換你的行：

但我認爲回答你的問題，你會使用UsedRange方法找到你的表的最後一欄，也許這樣的事情會更好

b = Excel.Sheets("Organise_R").Cells(1, Columns.Count).End(Excel.xlToLeft).column 

希望這有助於。