Question

我有一个预订系统（提供VLOOKUP字段的普通下拉列表）。我希望能够复制信息，我可以轻松地完成这项工作。问题是我希望工作表允许多次预订，每次预订完成后都可以完成第二次预订。目前它只是重写之前的预订，它不会向下移动可用的单元格！

下面是使用的代码，我知道它可能更整洁，但我在寻找它为什么不起作用。我在With部分424上显示错误，它通常会抱怨UsedRange。

Sub Bookingtry()
'
' Bookingtry Macro
'
' Keyboard Shortcut: Ctrl+h
'
    Range("A2").Select
    Sheets("Booking Form").Select
    Range("B2").Select
    Selection.Copy
    Sheets("Booking sheet").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2").Select
    Sheets("Booking Form").Select
    Range("B4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Booking sheet").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C2").Select
    Sheets("Booking Form").Select
    Range("B6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Booking sheet").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D2").Select
    Sheets("Booking Form").Select
    Range("B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Booking sheet").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E2").Select
    Sheets("Booking Form").Select
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Booking sheet").Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Booking Form").Select
    Range("B12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Booking sheet").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G2").Select
    Sheets("Booking Form").Select
    Range("B14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Booking sheet").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Sheets("Booking sheet").Cells(UsedRange.Columns(1).Rows.Count + 1, 1).Paste
    End With


End Sub

Answer 1

我清理你的代码以查看你想要做的事情，我想我对第一部分没问题。

但对于你的上一行＆＃34;＆＃34; （With与UsedRange），我真的没有得到你要粘贴的内容......其他所有内容都已粘贴。无论如何，我也纠正了最后一部分的语法，以便你可以使用它。

看看：

Sub Bookingtry()
' Keyboard Shortcut: Ctrl+h

Dim FirstEmptyRow As Long, _
    WsBF As Worksheet, _
    WsBS As Worksheet

Set WsBF = ThisWorkbook.Sheets("Booking Form")
Set WsBS = ThisWorkbook.Sheets("Booking sheet")

FirstEmptyRow = WsBS.Range("A" & WsBS.Rows.Count).End(xlUp).Row + 1

    WsBF.Range("B2").Copy
    WsBS.Range("A" & FirstEmptyRow).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

    WsBF.Range("B4").Copy
    WsBS.Range("B" & FirstEmptyRow).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

    WsBF.Range("B6").Copy
    WsBS.Range("C" & FirstEmptyRow).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

    WsBF.Range("B8").Copy
    WsBS.Range("D" & FirstEmptyRow).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

    WsBF.Range("B10").Copy
    WsBS.Range("E" & FirstEmptyRow).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

    WsBF.Range("B12").Copy
    WsBS.Range("F" & FirstEmptyRow).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

    WsBF.Range("B14").Copy
    WsBS.Range("G" & FirstEmptyRow).PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


End Sub

代码不会向下移动可用的单元格

1 个答案: