0

感谢有经验的程序员愿意提供帮助。我没有受过正规培训，所以在阅读我的代码时尽量不要笑得太厉害。这也是我第一次尝试寻求外部帮助，所以我真诚地希望我没有违反任何规则。

我有一个包含多张工作表的工作簿。我编写的宏试图将不同数量的单元格值（所有文本）（例如，一张表可能有 3 个要复制的项目，另一个可能有 10 个）复制到具有固定数量的 30 行的列中。我遇到的问题是试图即时弄清楚如何跟踪正在复制的数据何时超过了粘贴的剩余可用空间。复制前 30 个单元格后，我有一个 Select Case 语句，该语句偏移到 30 行的下一列等，并且宏继续执行，直到复制了最后一张有数据的工作表。

我正在复制我编写的代码 - 我希望这个窗口是正确的位置。

谢谢， 贾

Option Explicit

Sub UpdateDraw()
        ' This code will populate the Roll Call sheet
        ' 1. Go to Running Order sheet to get the sheet order
        ' 2. For each sheet determine the number entered in each stake
        ' 3. Copy the populated registration number from column D to the Roll Call sheet.
        ' 4. After 30 cells have been copied switch the column on the Roll Call sheet.
        ' 5. After 60 cells have been copied switch the column on the Roll Call sheet.
        ' 6. After 90 cells have been copied switch the column on the Roll Call sheet.

    Dim a, b, c, d, e, x As Integer
    Dim y As String

    a = 1 'Offset for pasting to Roll Call Sheet
    b = 0 'Offset for number of Open stake entries
    c = 0 'Offset for number of Special stake entries
    d = 0 'Offset for number of Veteran stake entries
    e = 0 'Offset for Column shift based on number of entries copied
    x = 0 'Loop counter - goes to 21
    y = "" 'Sheet to select based on loop counter

    Do Until x = 21
        Select Case a
            Case 1 To 30: e = 0 And a = 1
            Case 31 To 60: e = 5 And a = 1
            Case 61 To 90: e = -10 And a = 34
            Case 91 To 120: e = -5 And a = 34
            Case 121 To 150: e = 0 And a = 34
            Case 151 To 180: e = 5 And a = 34
        Case Else:
            MsgBox "Case Not Found"
        End Select


    Sheets("Running Order").Select

    With ActiveSheet
        y = .Range("A2").Offset(x, 0).Value
    End With
    If y = "RR(A)" Or y = "RR(B)" Then
        Sheets(y).Select
        'GoTo Copy_RR
    ElseIf y = "WH(A)" Or y = "WH(B)" Then
        Sheets(y).Select
        GoTo Copy_Wh
    Else:
        Sheets(y).Select
        GoTo Copy_Regular
    End If
Copy_Regular:
             'Select Copy data for Open Stake

            With ActiveSheet
                If .Range("L4") = 0 Then
                    'No entries on this sheet
                    b = 0
                ElseIf .Range("L4") = 1 Then
                    ActiveSheet.Range("D9").Copy
                    b = 1
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                ElseIf .Range("L4") > 1 Then
                    ActiveSheet.Range("D9", ActiveSheet.Range("D9").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D9:D20"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                End If

                'Select Copy data for Specials
                Sheets(y).Select
                If .Range("L27") = 0 Then
                a = a
                ElseIf .Range("L27") = 1 Then
                    ActiveSheet.Range("D32").Copy
                    c = 1
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + c
                ElseIf .Range("L27") > 1 Then
                    ActiveSheet.Range("D32", ActiveSheet.Range("D32").End(xlDown)).Copy
                    c = WorksheetFunction.CountA(ActiveSheet.Range("D32:D43"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + c
                Else:
                a = a
                End If

                'Select Copy data for Veterans
                Sheets(y).Select
                If .Range("L50") = 0 Then
                a = a
                ElseIf .Range("L50") = 1 Then
                    ActiveSheet.Range("D55").Copy
                    d = 1
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + d
                ElseIf .Range("L50") > 1 Then
                    ActiveSheet.Range("D55", ActiveSheet.Range("D55").End(xlDown)).Copy
                    d = WorksheetFunction.CountA(ActiveSheet.Range("D55:D66"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + d
                Else:
                a = a
                End If
            End With
            GoTo End_Loop

Copy_RR:
             'Select Copy data for Open Stake
            Sheets(y).Select
            With ActiveSheet
                If .Range("L4") = 0 Then
                    'No entries in Open
                    b = 0
                ElseIf .Range("L4") > 0 And .Range("L4") <= 12 Then
                    ActiveSheet.Range("D9", ActiveSheet.Range("D9").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D9:D20"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                            Sheets(y).Select
                ElseIf .Range("L4") > 12 And .Range("L4") <= 19 Then
                    ActiveSheet.Range("D9", ActiveSheet.Range("D9").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D9:D20"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                    Sheets(y).Select
                    ActiveSheet.Range("D32", ActiveSheet.Range("D32").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D32:D43"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                End If

                'Select Copy data for Specials
                Sheets(y).Select
                If .Range("L50") = 0 Then
                    'No entries on this sheet
                    c = 0
                ElseIf .Range("L50") > 0 And .Range("L50") <= 12 Then
                    ActiveSheet.Range("D55", ActiveSheet.Range("D55").End(xlDown)).Copy
                    c = WorksheetFunction.CountA(ActiveSheet.Range("D55:D66"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + c
                            Sheets(y).Select
                ElseIf .Range("L50") > 12 And .Range("L50") <= 19 Then
                    ActiveSheet.Range("D55", ActiveSheet.Range("D55").End(xlDown)).Copy
                    c = WorksheetFunction.CountA(ActiveSheet.Range("D55:D66"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + c
                            Sheets(y).Select
                    ActiveSheet.Range("D78", ActiveSheet.Range("D78").End(xlDown)).Copy
                    c = WorksheetFunction.CountA(ActiveSheet.Range("D78:D89"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + c
                End If

                'Select Copy data for Veterans
                Sheets(y).Select
                If .Range("L96") = 0 Then
                'No entries in Veterans
                a = a
                ElseIf .Range("L96") > 0 And .Range("L96") <= 12 Then
                    ActiveSheet.Range("D101", ActiveSheet.Range("D101").End(xlDown)).Copy
                    d = WorksheetFunction.CountA(ActiveSheet.Range("D101:D112"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + d
                ElseIf .Range("L96") > 12 Then
                MsgBox "Houston we have a problem! More than 12 in Veterans requires another sheet."
                Stop
                Else:
                a = a
                End If
            End With
            GoTo End_Loop

Copy_Wh:

            Sheets(y).Select
            With ActiveSheet
                If .Range("L4") = 0 Then
                    'No entries in Open
                    b = 0
                ElseIf .Range("L4") > 0 And .Range("L4") <= 12 Then
                    ActiveSheet.Range("D9", ActiveSheet.Range("D9").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D9:D20"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                            Sheets(y).Select
                ElseIf .Range("L4") > 12 And .Range("L4") <= 24 Then
                    ActiveSheet.Range("D9", ActiveSheet.Range("D9").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D9:D20"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                    Sheets(y).Select
                    ActiveSheet.Range("D32", ActiveSheet.Range("D32").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D32:D43"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                ElseIf .Range("L4") > 24 And .Range("L4") <= 29 Then
                    ActiveSheet.Range("D9", ActiveSheet.Range("D9").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D9:D20"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                    Sheets(y).Select
                    ActiveSheet.Range("D32", ActiveSheet.Range("D32").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D32:D43"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                    Sheets(y).Select
                    ActiveSheet.Range("D55", ActiveSheet.Range("D55").End(xlDown)).Copy
                    b = WorksheetFunction.CountA(ActiveSheet.Range("D55:D66"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + b
                End If

                'Select Copy data for Specials
                Sheets(y).Select
                If .Range("L73") = 0 Then
                    'No entries on this sheet
                    c = 0
                ElseIf .Range("L73") > 0 And .Range("L73") <= 12 Then
                    ActiveSheet.Range("D78", ActiveSheet.Range("D78").End(xlDown)).Copy
                    c = WorksheetFunction.CountA(ActiveSheet.Range("D78:D89"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + c
                            Sheets(y).Select
                ElseIf .Range("L73") > 12 And .Range("L73") <= 19 Then
                    ActiveSheet.Range("D78", ActiveSheet.Range("D78").End(xlDown)).Copy
                    c = WorksheetFunction.CountA(ActiveSheet.Range("D78:D89"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + c
                            Sheets(y).Select
                    ActiveSheet.Range("D101", ActiveSheet.Range("D101").End(xlDown)).Copy
                    c = WorksheetFunction.CountA(ActiveSheet.Range("D101:D112"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + c
                            Sheets(y).Select
                    ActiveSheet.Range("D124", ActiveSheet.Range("D124").End(xlDown)).Copy
                    c = WorksheetFunction.CountA(ActiveSheet.Range("D124:D135"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + c
                End If

                'Select Copy data for Veterans
                Sheets(y).Select
                If .Range("L142") = 0 Then
                'No entries in Veterans
                a = a
                ElseIf .Range("L142") > 0 And .Range("L142") <= 12 Then
                    ActiveSheet.Range("D147", ActiveSheet.Range("D147").End(xlDown)).Copy
                    d = WorksheetFunction.CountA(ActiveSheet.Range("D147:D158"))
                        Sheets("ASFA Certs_RollCall").Activate
                            With ActiveSheet
                                .Range("K3").Offset(a, e).Select
                                .Range("K3").Offset(a, e).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            End With
                            a = a + d
                ElseIf .Range("L142") > 12 Then
                MsgBox "Houston we have a problem! More than 12 in Veterans requires another sheet."
                Stop
                Else:
                a = a
                End If
            End With
            GoTo End_Loop
End_Loop:
    x = x + 1
    Loop

End Sub
4

1 回答 1

0

和其他发表评论的人一样，我被你写的大量代码淹没了。我将提供一小段您可能可以使用的代码——它需要一些调整，但它可能会有所帮助。

dim curRow, curCol
dim c as Cell

' loop around the regions you want to select (pick first cell, extend with .End(xlDown) )
' select the data you want to copy, then
For each c in Selection.Cells
    if curRow < 30 Then 
        curRow = curRow+1 
    Else
        curRow = 1
        curCol = curCol + 1
    End If
    [A1].offset(curRow, curCol).Value = c
Next c

' repeat for next region... this can be a loop too

如您所见，这使用curRow和curCol变量来跟踪数据将被复制到哪里。通过一次考虑一个单元格，我们可以不断更新目标地址。显然，您需要调整偏移量（而不是 Range("A1") 的简写 [A1]，使用正确的起始地址）。

我希望这有帮助。

于 2013-03-20T04:11:33.183 回答