将单元格值和粘贴复制到列表/表中的另一个工作表

时间:2018-05-16 18:31:12

标签: excel vba

我是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的最后一个复制和粘贴行将粘贴,但它没有在下面找到空单元格并覆盖其上方的信息。我不知道为什么。

感谢任何和所有帮助。

谢谢,

2 个答案:

答案 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