感谢有经验的程序员愿意帮忙。我没有接受过正式培训，所以在阅读我的代码时尽量不要笑得太厉害。这也是我第一次尝试寻求外界帮助，所以我真诚地希望我不违反任何规则。
我有一张包含多张纸的工作簿。我写的宏试图将不同数量的单元格值（所有文本）（例如，一个工作表可能有3个项目要复制，另一个可能有10个）复制到具有固定数量30行的列中。我遇到的问题是试图弄清楚如何跟踪复制数据何时超出剩余可用空间。在复制了前30个单元格之后，我有一个Select Case语句，该语句会偏移到下一列30行等，并且宏会一直持续到最后一张已复制数据的工作表。
我正在复制我写的代码 - 我希望这个窗口是正确的位置。
谢谢，JA
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
答案 0 :(得分：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变量来跟踪数据的复制位置。通过一次考虑一个单元，我们可以继续更新目标地址。显然你需要调整偏移量（而不是[A1]，这是范围（“A1”）的简写，使用正确的起始地址）。
我希望这会有所帮助。