喜んで手伝ってくれた経験豊富なプログラマーに感謝します。私は正式なトレーニングを受けていないので、コードを読むときに笑いすぎないようにしてください。外部に助けを求めるのもこれが初めてなので、ルールに違反しないことを心から願っています。
複数のシートを含むワークブックがあります。私が書いたマクロは、さまざまな数のセル値 (すべてのテキスト) をコピーしようとしています (たとえば、1 つのシートにはコピーする項目が 3 つ、別のシートには 10 項目がある場合があります)。私が抱えている問題は、コピーされているデータが貼り付け可能な残りのスペースを超えたときを追跡する方法をその場で見つけようとしていることです。最初の 30 個のセルがコピーされた後、次の 30 行の列にオフセットする Select Case ステートメントがあり、データがコピーされた最後のシートまでマクロが続行されます。
私が書いたコードをコピーしています。このウィンドウが正しい場所であることを願っています。
ありがとう、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