將可變範圍的數據傳輸到新工作簿

Question

對不起，如果這是一個簡單的修復，我是VBA的新手。基本上我有一堆工作簿（輸入，稱爲測試），並希望將所有數據傳輸到一個新的工作簿（輸出，稱爲Batch1）。輸入中的前兩行需要合併到輸出中的第一行，我已經成功完成了這一步。

其餘數據（輸入中所有表單中所有列的第3行和第2行）需要放在第2行中，並放在輸出中適當的列中。我想避免使用剪貼板，因爲我已經讀過，它使事情變得複雜。我相信我的問題是，我循環瀏覽工作表中的列意味着數據範圍是可變的，我試圖對此進行補救。這是我的代碼。

Sub Headings() 

    Dim WS_Count As Integer 'define variables 
    Dim j As Integer 
    Dim k As Integer 
    k = 1 
    Dim ws As Worksheet 
    Dim out As Workbook 
    Dim Data As Range 
    Dim Space As Range 
    Dim InC1 As Range 
    Dim InC2 As Range 
    Dim OutC1 As Range 
    Dim OutC2 As Range 
    Set out = Workbooks("Batch1.xlsm") 

    ' Set up worksheet loop. 
    For Each ws In ActiveWorkbook.Worksheets 

     colCount = ws.UsedRange.Rows(1).Columns.Count 'Count number of coloumns in particular worksheet 
     RowCount = ActiveSheet.UsedRange.Rows.Count 'Count number of rows in particular worksheet 

     'Looped Code Follows 

     For j = 1 To colCount 

     ws.Activate 'Activate input worksheet in question 

     Parameter = Cells(1, j) 
     Units = Cells(2, j) 

     Combine = Parameter & " " & Units 'Combine top two rows with space between 

     Set InC1 = Cells(3, j) 
     Set InC2 = Cells(RowCount, j) 
     Set Data = Range("InC1:InC2") 

     out.Sheets("Sheet1").Activate 'Open output worksheet 

     Cells(1, k) = Combine 'Input values into output sheet 

     Set OutC1 = Cells(2, k) 
     Set OutC2 = Cells(RowCount, k) 
     Set Space = Range("OutC1:OutC2") 
     Space = Data 

     k = k + 1 'Steps through columns, keeping space in output 

     Next j 


    Next 

    End Sub 

我一直在收到各種各樣的錯誤，我認爲這是關於如何爲每列「j」定義數據範圍。同樣出於某種原因，行計數返回47的值，儘管事實上每個輸入表中只有17-20行，這不會改變任何東西，但是很煩人。

請不要覺得你需要修復我的代碼，只是寫一個簡單的函數來顯示我在哪裏搞砸了綽綽有餘。

在此先感謝您的幫助！

Answer 1

代碼有幾個問題。請參閱說明：

Sub Headings() 

Dim WS_Count As Integer 'define variables 
Dim j As Integer 
Dim k As Integer 
k = 1 
Dim ws As Worksheet 
Dim out As Workbook 
Dim Data As Range 
Dim Space As Range 
Dim InC1 As Range 
Dim InC2 As Range 
Dim OutC1 As Range 
Dim OutC2 As Range 
Dim ows As Worksheet 
Dim rowCount& 
Set out = Workbooks("Batch1.xlsm") 
Set ows = out.Sheets("Sheet1") 
' Set up worksheet loop. 
For Each ws In ThisWorkbook.Worksheets 

    colCount = ws.UsedRange.Rows(1).Columns.Count 'Count number of coloumns in particular worksheet 
    rowCount = ws.UsedRange.Rows.Count 'Count number of rows in particular worksheet 

    'Looped Code Follows 

    For j = 1 To colCount 
     'avoid activate by setting the parentage directly. 
     'ws.Activate 'Activate input worksheet in question 

     Parameter = ws.Cells(1, j) 
     Units = ws.Cells(2, j) 

     Combine = Parameter & " " & Units 'Combine top two rows with space between 

     Set InC1 = ws.Cells(3, j) 
     Set InC2 = ws.Cells(rowCount, j) 
     Set Data = ws.Range(InC1.Address(0,0) & ":" & InC2.Address(0,0)) 'variable need to outsid the qoutes 

     'out.Sheets("Sheet1").Activate 'Open output worksheet 

     ows.Cells(1, k) = Combine 'Input values into output sheet 

     Set OutC1 = ows.Cells(2, k) 
     Set OutC2 = ows.Cells(rowCount, k) 
     Set Space = ows.Range(OutC1.Address(0,0) & ":" & OutC2.Address(0,0)) 
     Space.Value = Data.Value 

     k = k + 1 'Steps through columns, keeping space in output 

    Next j 


Next 

End Sub 

Answer 2

如果象出現時，你只是想從一個工作表複製一個範圍到另一個（即使是另一片不同的工作簿），你只需設置一個範圍的Value別人：

Dim rng1 As Range 
Dim rng2 As Range 

Application.ScreenUpdating = False 

Set rng1 = Sheets(1).UsedRange 
Set rng2 = Sheets(2).Range("A1").Resize(rng1.Rows.Count, rng1.Columns.Count) 

rng2.Value = rng1.Value 

這不使用剪貼板。

Resize用於確保兩個區域的大小相同。

您需要修改此以包含對第二個工作簿的引用（並使用Worksheets集合而不是Sheets）。

您可以根據您的要求調整範圍（或複製整個範圍，然後替換第一行）。

---

要解決幾個問題與OP代碼：

這

Set Data = Range("InC1:InC2") 

使用文字文本 「INC1：INC2」 它不是取代這些變量的值。它應該是

Set Data = ws.Range(InC1.Address(0,0) & ":" & InC2.Address(0,0)) 

或

Set Data = ws.Range(InC1.Cells(1), InC2.Cells(1)) 
    'not worrying about dollar signs 

你也應該避免激活（和選擇）通常，他們是低效的和不必要的。爲工作簿和工作表設置明確的引用有助於避免它們的使用，但也使得代碼不易出錯 - 這很容易，否則，當您仍然引用另一個工作表中的範圍時，認爲您指的是一個工作表中的範圍。