我是Excel VBA的新手,最近负责创建一个宏,该宏从一个包含下拉列表和公式的工作表复制到另一个“输出”表,将这些保存在一个很好的列表(表)中以供参考。
我的代码设计用于执行从sheet1和pastevalue到sheet2的简单复制,并设置为搜索包含连续数据的最后一个单元格,然后将其偏移到下面粘贴到空单元格中。这适用于我尝试做的大部分工作,但我遇到的问题是代码的一部分没有在行“J”中正确粘贴。
这是我的代码:
Sub TestCopyToDB()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("PIT Training Request Form")
Set pasteSheet = Worksheets("Output")
copySheet.Range("C2:D2").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
copySheet.Range("C3").Copy
pasteSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
copySheet.Range("C4").Copy
pasteSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
copySheet.Range("C5").Copy
pasteSheet.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
copySheet.Range("C6").Copy
pasteSheet.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
copySheet.Range("C7").Copy
pasteSheet.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
copySheet.Range("C8").Copy
pasteSheet.Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
copySheet.Range("E8").Copy
pasteSheet.Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
copySheet.Range("C11:D11").Copy
pasteSheet.Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
copySheet.Range("H16").Copy
pasteSheet.Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).Row.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=xlCopy, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets("PIT Training Request Form").Range("C3").ClearContents
Sheets("PIT Training Request Form").Range("C4").ClearContents
Sheets("PIT Training Request Form").Range("C5").ClearContents
Sheets("PIT Training Request Form").Range("C6").ClearContents
Sheets("PIT Training Request Form").Range("C7").ClearContents
Sheets("PIT Training Request Form").Range("C8").ClearContents
Sheets("PIT Training Request Form").Range("C11:D11").ClearContents
Sheets("PIT Training Request Form").Range("E8").ClearContents
Sheets("PIT Training Request Form").Range("D9").ClearContents
Sheets("PIT Training Request Form").Range("D10").ClearContents
Sheets("PIT Training Request Form").Range("D14").ClearContents
Sheets("PIT Training Request Form").Range("D15").ClearContents
Sheets("PIT Training Request Form").Range("D16").ClearContents
End With
Sheets("PIT Training Request Form").Select
MsgBox "Submission Complete.", vbInformation
End Sub
来自H16的最后一个复制和粘贴行将粘贴,但它没有在下面找到空单元格并覆盖其上方的信息。我不知道为什么。
感谢任何和所有帮助。
谢谢,
答案 0 :(得分:0)
我觉得你的代码比它需要的更复杂。我已经为您创建了一些新代码,这样更容易。您需要输入实际值,但我认为我已经足够简单了。
Sub logInformation()
'GET VALUES
Dim fName As String
Dim lName As String
Dim age As String
Dim gender As String
fName = Sheet1.Range("B2")
lName = Sheet1.Range("C2")
age = Sheet1.Range("B3")
gender = Sheet1.Range("B4")
'INSERT VALUES
Dim tbl As ListObject
Set tbl = Sheet2.ListObjects("Table1")
Dim row As ListRow
Set row = tbl.ListRows.Add
With row
.Range(1) = fName
.Range(2) = lName
.Range(3) = age
.Range(4) = gender
End With
'CLEAR FORM
Sheet1.Range("B2").Clear
Sheet1.Range("C2").Clear
Sheet1.Range("B3").Clear
Sheet1.Range("B4").Clear
End Sub
- 或 -
你也可以循环它,让它变得更容易
Sub logInformation()
Dim tbl As ListObject
Set tbl = Sheet2.ListObjects("Table1")
Dim row As ListRow
Set row = tbl.ListRows.Add
Dim arr As Variant
arr = Array("C2", "D2", "C3", "C4", "C5", "C6", "C7", "C8", "E8", "C11", "C12", "C13", "C14", "C15", "C16", "H16")
For i = LBound(arr) To UBound(arr)
row.Range(i + 1) = Sheet1.Range(arr(i)).value
Sheet1.Range(arr(i)).Clear
Next i
End Sub
答案 1 :(得分:0)
一般建议是设置输出范围。在上面的代码中,哪个列是“J”有点不清楚。看起来您的“H16”复制命令的粘贴引用了 Row.PasteSpecial ,这可能是导致错误的原因:
<div class="row">
<div class="col-md-6">
<kendo-chart [categoryAxis]="{ categories: categories }">
<kendo-chart-title text="Gross domestic product growth /GDP annual %/"></kendo-chart-title>
<kendo-chart-legend position="bottom" orientation="horizontal"></kendo-chart-legend>
<kendo-chart-tooltip format="{0}%"></kendo-chart-tooltip>
<kendo-chart-series>
<kendo-chart-series-item *ngFor="let item of series"
type="line" [data]="item.data" [name]="item.name">
</kendo-chart-series-item>
</kendo-chart-series>
</kendo-chart>
</div>
<div class="col-md-6">
<kendo-chart [categoryAxis]="{ categories: categories }">
<kendo-chart-title text="Gross domestic product growth /GDP annual %/"></kendo-chart-title>
<kendo-chart-legend position="bottom" orientation="horizontal"></kendo-chart-legend>
<kendo-chart-tooltip format="{0}%"></kendo-chart-tooltip>
<kendo-chart-series>
<kendo-chart-series-item *ngFor="let item of series"
type="line" [data]="item.data" [name]="item.name">
</kendo-chart-series-item>
</kendo-chart-series>
</kendo-chart>
</div>
</div>
我在上面的代码中循环复制/粘贴。这可能更容易操作和调试。
copySheet.Range("H16").Copy
pasteSheet.Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).Row.PasteSpecial