将可变范围的数据传输到新的工作簿

对不起，如果这是一个简单的修复，我是VBA的新手。 基本上我有一堆工作簿（input，称为testing），并希望将所有数据传输到一个新的工作簿（输出，称为Batch1）。 input中的前两行需要合并到输出中的第一行，我已经成功完成了这一步。

其余数据（input中所有表单中的所有列的第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，尽pipe事实上在每个input表中只有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设置为其他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 ）。

您可以调整范围以适合您的要求（或复制整个范围，然后replace第一行）。

---

为了解决与OP的代码有关的几个问题：

这个

  Set Data = Range("InC1:InC2") 

正在使用文字“InC1：InC2”它不会代替这些variables的值。 它应该是

  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 

你也应该避免激活（和select），他们是低效率和不必要的。 为工作簿和工作表设置明确的引用有助于避免它们的使用，但是也使得代码更不容易出错 – 这是相当容易的，否则当你仍然引用另一个表中的范围时， 。