我想将多个工作表/选项卡中的数据复制到主工作表
我所拥有的是一个电子表格，其中有超过100个具有相同格式数据的选项卡，但有些表格的行数多于或less于其他行数。 我有一张名为EMP_NUM的工作表， 其中包含所有员工编号和姓名。 我有一个主表，我想所有的相关数据复制到主表。 表EMP_NUM中列出的员工编号与100多张工作表的名称相匹配。 最后，我希望Master工作表上的每一行都有第一个单元格作为员工编号，那么行中剩余的单元格就是从其他所有工作表单中收集的数据。
需要复制的员工＃表的数据从A4开始，在TX结束，其中X等于仍然有值的列A中最大的行数。
我正在考虑使用EMP_NUM中的数据在过程中调用，以便find正确的用于复制数据的表单，因为它们将匹配，而且还可以用作行中的第一个单元格。
一旦完成，我可以添加我的公式来计算数据。 在Excel中使用VB进行了一点点小小的调整已经有6年多了，我不知道该怎么做。 感谢大家的帮助！！ 请让我知道，如果我需要清除任何东西。
**添加**
我会想象的第一步是find第一张来复制数据。 要find第一个工作表，函数应该转到EMP_NUM工作表，看看第一个数字是什么，这个数字和我们想要的工作表的名字完全相关。 那可以是intEmpNum
然后在相应的表格上，我计算出第4行有多less行有数据。 这些行将是要复制的范围。 复制这个范围在图表Master上的第一个可用的行，从列B开始，现在留下A列空白。 列A是针对在列B中具有数据但不在列A中的所有行的intEmpNum 。
然后findEMP_NUM上的下一个员工编号并重复该过程，直到工作表Emp_NUM上的列A中没有更多的员工编号
这是我迄今为止 –
Sub Button1_Click() Dim intEmpNum As Integer 'employee number Dim strEmpCell As String 'row that employee number is in strEmpCell = 1 Do Until Sheets("EMP_NUM").Range("A" + strEmpCell).Value = 0 intEmpNum = Sheets("EMP_NUM").Range("A" + strEmpCell).Value strEmpCell = strEmpCell + 1 Loop MsgBox ("The value was not found!") End Sub 我认为你对目前为止的代码有正确的想法。 但是我会考虑使用dynamic范围名称来设置员工号码列表。 所以你可能有一个范围名称。
使用以下公式创build一个名为“EmployeeNum”的新范围
=OFFSET("EMP_NUM!$A1",0,0,COUNTA("EMP_NUM!$A:$A"),1)
这使得循环代码更容易处理
Sub getEmployeeData() Dim rCell As Range Dim dblPasteRow As Double 'Start pasting in first row For Each rCell In Range("EmployeeNum") dblPasteRow = dblPasteRow + CopyData(rCell.Value, dblPasteRow) Next rCell End Sub
我正在使用一个函数来进行复制。 首先，它把代码分解成你需要的两个小工作。 其次，一个函数可以返回数据，所以我们可以让调用子知道我们粘贴了多less行数据。
Function CopyData(strEmpNum As String, dblPasteStart As Double) As Double Dim wksEmployee As Worksheet Dim dblEndRow As Double 'If there is an error, we are adding 0 rows CopyData = 0 'Error handling - if sheet isn't found On Error GoTo Err_NoSheetFound 'Set a worksheet object to hold the employee data sheet Set wksEmployee = Sheets(strEmpNum) On Error GoTo 0 With wksEmployee 'Find the last row on the worksheet that has data in column A dblEndRow = .Range("A4").End(xlDown).Row 'Copy data from this sheet Range(.Range("A4"), .Range("T" & dblEndRow)).Copy End With 'Paste data to master sheet - offset to column B Range(Worksheets("MASTER").Range("B" & dblPasteStart), Worksheets("MASTER").Range("U" & dblPasteStart + dblEndRow)).Paste 'Write employee numbers next to the data Range(Worksheets("MASTER").Range("A" & dblPasteStart), Worksheets("MASTER").Range("A" & dblPasteStart + dblRowEnd)).Value = strEmpNum 'Let the calling sub know how many rows we added CopyData = dblEndRow Exit Function 'Only runs if an error is found Err_NoSheetFound: Debug.Print "Can't find employee number: " & strEmpNum End Function
我没有运行代码，所以可能会有一些错误。 我希望它至less能指出你正确的方向。
我最近select了一个VBA项目。 把你的工作分解成更小的任务。
以下是如何在表单中find给定的名称wn：
Dim wn as String Dim COLUMN_WHERE_ID_IS as String COLUMN_WHERE_ID_IS = "B" For srow = 1 To Worksheets(wn).Range("B65536").End(xlUp).row If (Worksheets(wn).Range(COLUMN_WHERE_ID_IS & srow & ":" & COLUMN_WHERE_ID_IS & srow).Value = NAME) Then '' copy stuff to target you have range now Exit For End If Next srow
现在创build一个将遍历所有单元格并检索NAME的函数，然后调用上面的子例程。 然后你需要find如何遍历所有表单。
注意这是非常无效的。 从algorithm的angular度来看，您应该将所有EMP NUM都放置到Set结构中，并在检查任何工作表时检查set.contains（_empnum）。