Question

UPDATE

我的问题一半已经解决，但我仍然遇到问题。我要粘贴到新工作簿的大多数数据都可以正常工作。如果多次按该按钮，则数据将粘贴到下一个可用行。但是，特别是三行无效。第一次按下宏按钮时，数据将粘贴到正确的位置，但是数据将从适当的行向下粘贴31行。我对此完全感到困惑。工作表中该部分的单元格是否存在某种格式问题？任何帮助将不胜感激。

原始问题

让我解释发生了什么。我正在尝试这样做，以便一旦在一个工作簿中填写了表单，用户就可以按一个按钮，然后将来自该表单的数据复制并粘贴到另一个工作簿中，该工作簿对所有数据都像一个主文件。表单中的数据应该粘贴在第二个工作簿的特定列中。

到目前为止，我已经成功创建了可以完成此任务的粗略但有效的代码，但是现在我遇到了一些问题。当我按第一个工作簿上的按钮时，所有内容都会按预期粘贴，但是单元格（特别是G163）将粘贴数据。我检查了一下，代码中没有任何内容专门将宏粘贴到该单元格。另外，如果我第二次按下按钮，某些单元格将不会粘贴到下一个可用的空单元格中，而是会被向下推并粘贴到与预期不同的单元格中。

我对excel vba还是很陌生，因此将不胜感激。我将在下面发布我的代码以及一些奇数粘贴的图片。

Sub Button1099_Click()

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("A42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("A4").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("A42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("A4").Copy
Range("A" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("A" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("B42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("P2").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("B42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("P2").Copy
Range("B" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("B" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("C42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("P3").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("C42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("P3").Copy
Range("C" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("C" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("D42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("C10").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("D42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("C10").Copy
Range("D" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("D" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("E42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("C9").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("E42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("C9").Copy
Range("E" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("E" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("F42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("C11").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("F42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("C11").Copy
Range("F" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("F" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("G42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("B17").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("G42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("B17").Copy
Range("G" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("G" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("H42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("C12").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("H42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("C12").Copy
Range("H" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("H" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("I42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("J10").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("I42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("J10").Copy
Range("I" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("I" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

If IsEmpty(Workbooks("2018Monthly.xls").Worksheets("7").Range("J42")) = True Then
Workbooks("Formtest.xlsm").Worksheets("Form").Range("J11").Copy
Workbooks("2018Monthly.xls").Worksheets("7").Range("J42").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Else
Workbooks("Formtest.xlsm").Worksheets("Form").Range("J11").Copy
Range("J" & Rows.count).End(xlUp).Offset(1).Select
Workbooks("2018Monthly.xls").Worksheets("7").Range("J" & Rows.count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End If

 Application.CutCopyMode = False
 Workbooks("2018Monthly.xls").Save

End Sub

这是您单击按钮一次后第二个工作簿的外观：

Pasted workbook after one button press

如果再次按下该按钮，工作簿将如下所示：

Pasted workbook after two button presses

Answer 1

由于您要复制单元到单元，因此请尝试此操作；

Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Workbooks("Formtest.xlsm").Worksheets("Form")
Set ws2 = Workbooks("2018Monthly.xls").Worksheets("7")

Dim lRow As Long
lRow = ws2.Range("A" & Rows.Count).End(xlUp).Row

If ws2.Range("A42").Value = "" Then
    ws2.Range("A42").Value = ws1.Range("A4").Value
Else: ws2.Range("A" & lRow).Offset(1).Value = ws1.Range("A4").Value
End If

将数据从一个工作簿复制并粘贴到另一个工作簿，导致随机单元获取数据/空行未获取粘贴数据

1 个答案: