EXCEL VBA – 将符合条件的列从一个工作表复制到格式化工作表

我非常熟悉vlookup ，数据透视表，但觉得这可以用VBA完成。

这是我想要做的：

Sheet 1 ：带有标题的数据表。 Sheet 2 ：使用特定外观和数据进行格式化的汇总表只能粘贴到从row 10开始的工作表中。

• 在sheet 2, B5有一个允许您select名称的下拉列表。
• 我希望有人能够检查Sheet 2 B5的值是否与Sheet 1 Column A相匹配。
• 那么代码将返回到数据表（ sheet 1 ），并在column A检查是否与Sheet 2 B5匹配。
• 如果页面Sheet 2 B5与页面Sheet 1 Column A匹配，则复制页面Sheet 1栏B, C, D, E, H, I, J, K, L, M, N, R, S, T, U, V, W, X, Y ，匹配Sheet 2 B5值，INTO sheet 2从row 10开始。

其他注意事项 – 来自工作Sheet 1格式不能复制到工作Sheet 2 。 我只需要内容。 – 运行代码的button在sheet 2 。 （因此， sheet 2是macros运行时的活动页面）。

我的代码到目前为止…

 Sub Report () Dim finalrow As Integer, i as Integer, name as String Sheets("Sheet 2").Range("A10:N29").ClearContents name = Sheets("Sheet 2").Range("B5").Value For i = 2 To Sheets("Sheet 1").Range("B" & Rows.Count).End(xlUp).Row If Cells(i, 1) = name Then Range(Cells(i, 2), Cells(i, 25)).Select Selection.Copy Worksheets("Sheet 2").Select erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row ActiveSheet.Cells(erow, 1).Select ActiveSheet.PasteSpecial xlPasteFormulasAndNumberFormats End If Next i End Sub 

但我不断收到

运行时错误9。

Answer 1

运行时错误主要是由于没有正确寻址单元而发生的。 如果你使用明确的编码，你不太可能得到这些错误，而且你的代码也很容易看清楚。 也使用评论。

 Option Explicit Sub Report () 'Declare variables Dim name as String Dim wsh1 As Worksheet, wsh2 As Worksheet Dim erow As Long, i as Long 'Set the sheets Set wsh1 = ThisWorkbook.Worksheets("Sheet 1") Set wsh2 = ThisWorkbook.Worksheets("Sheet 2") 'clean destination worksheet wsh2.Range("A10:N29").ClearContents name = wsh2.Range("B5").Value 'condition for copying 'loop over reference sheet For i = 2 To wsh1.Range("B" & Rows.Count).End(xlUp).Row 'Check if the row meets the condition If wsh1.Cells(i, 1) = name Then wsh1.Range(wsh1.Cells(i, 2), wsh1.Cells(i, 25)).Copy 'copy the row erow = wsh2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'find last row in wsh2 wsh2.Cells(erow, 1).PasteSpecial xlPasteFormulasAndNumberFormats 'paste only values End If Next i End Sub 

更新：

由于OP提到它应该总是在第10行，那么这将是比使用最后一行更好的方法：

在代码的开始和for循环之外定义erow = 10 。 那么你的if块应该是这样的：

 If wsh1.Cells(i, 1) = name Then 'Check if the row meets the condition wsh1.Range(wsh1.Cells(i, 2), wsh1.Cells(i, 25)).Copy 'copy the row wsh2.Cells(erow, 1).PasteSpecial xlPasteFormulasAndNumberFormats 'paste only values erow = erow + 1 End If