Question

我有创建一堆新工作表的代码，然后为它们命名，然后循环遍历它们，在数据集中搜索工作表的名称，并将与该工作表名称匹配的值的数据行转置。

我已经开始将每一行移至右侧的下一列，但是出于打印目的，我希望它移至最后一个粘贴的单元格的底部，跳过一行（或者更好的是，插入一个分页符），然后粘贴下一个。

关于我试图告诉它计算行数，向下移动然后重新开始的某种方式不起作用。它似乎在以前粘贴的数据上粘贴了多次。

我尝试了几种不同的方法来计算行数，添加行或插入分页符，但我无法使其正常工作。我以为可能需要将rowcount函数移出IF语句，但这也不起作用。

Sub Franchise_Data4()
'searches Raw Data sheet for the Franchise ID associated with each sheet name; then transposes each relevant row onto the associated sheet'

Dim Scol As Range, Cell As Object, rawdata As Worksheet, ws As Worksheet, lc As Long, rowcountA As Integer, startR As Integer, labels As Range

Set rawdata = ThisWorkbook.Worksheets("Raw Data")
Set Scol = rawdata.Range("$C$2:$C$2000") 'Franchise ID column on Raw Data sheet'
Set labels = ThisWorkbook.Worksheets("Raw Data").Range("A1:AZ1")

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Raw Data" And ws.Name <> "Pivot" Then
            With ws 'cycles through all of the sheets with Franchise ID's as the name
            startR = 0

                For Each Cell In Scol 'should scan the C column on the Raw Data sheet'
                    If IsEmpty(Cell) Then Exit For

                    If Cell.Value = ws.Name Then 'checks for cells that contain the same Franchise ID as the current sheet in the cycle'
                    Cell.EntireRow.Copy
                    ws.Cells(startR + 1, 2).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                    xlNone, SkipBlanks:=False, Transpose:=True

                    labels.Copy
                    ws.Cells(startR + 1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                    xlNone, SkipBlanks:=False, Transpose:=True

                    End If
                    rowcountA = Cells(Cells.Rows.Count, "A").End(xlUp).Row
                    startR = rowcountA + 1
                Next
            End With
        End If
    Next ws

Application.CutCopyMode = False
End Sub

似乎正确粘贴了第一个数据集，然后向下移动了1行（而不是rowcount + 1）并再次粘贴。然后我想它要么停止，要么继续将其余部分粘贴到同一位置。

Answer 1

您需要完全限定Worksheet所在的Cells。

rowcountA = Cells(Cells.Rows.Count, "A").End(xlUp).Row

这里有一个隐式ActiveSheet，而不是您想要的对ws的引用。您已经有一个With ws...End With，因此请将此行更改为：

rowcountA = .Cells(.Rows.Count, "A").End(xlUp).Row

请注意，在其他情况下，您将“重复” ws，而不是充分利用With ws...End With。

在嵌套循环内设置动态粘贴范围

1 个答案: