Question

很抱歉，如果这是一个简单的修复，我是VBA的新手。基本上我在工作簿中有一堆工作表（输入，称为测试），并希望将所有数据传输到新工作簿（输出，称为Batch1）。输入中的前两行需要组合到输出的顶行，我已经成功完成了这一行。

其余数据（输入中所有工作表中所有列的第3行和第3行）需要放在第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”的数据范围有关。出于某种原因，尽管每个输入表中只有17-20行，但行计数返回的值为47，这不会改变任何东西，但是很烦人。

请不要觉得你需要修改我的代码，只需编写一个简单的函数来向我展示我搞砸的地方就足够了。

提前感谢您的帮助！

Answer 1

如果出现，您只想将一个范围从一个工作表复制到另一个工作表（即使该另一个工作表位于不同的工作簿中），您只需将一个范围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")

正在使用文字文字＆＃34; InC1：InC2＆＃34;它不是替代这些变量＆＃39;值。它应该是

    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

你也应该经常避免激活（和选择），它们效率低下且不必要。设置对工作簿和工作表的显式引用有助于避免使用它们，但也使代码不易出错 - 当你仍在引用另一个工作表中的范围时，很容易认为你指的是一个工作表中的范围

Answer 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
 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

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

2 个答案: