[英]VBA Copy filled cells in selected range in all sheets within the workbook to one summary sheet
could anybody help please? 有人可以帮忙吗? I was searching for VBA macro which will help me to summarize data from many forms.
我正在寻找VBA宏,这将有助于我总结多种形式的数据。 But I didnt find anything which is working for me.
但是我没有发现任何对我有用的东西。
I have workbook with huge number of sheets. 我的工作簿有大量的工作表。 The sheets are forms, which were filled by customers (each sheet is called FORM_number).
这些工作表是由客户填写的表单(每个工作表称为FORM_number)。 The problem is that people didnt fill up the forms in normal order - starting from the top row (in my case A5) but in a range (A5:K30) anywhere (example in row starting in A:10 and then A:15 and then A:22 and A:23).
问题是人们没有按正常顺序填写表格-从第一行(在我的情况下为A5)开始,但在任意范围(A5:K30)范围内(例如,从A:10开始,然后从A:15开始,然后是A:22和A:23)。 The task which the macro should do, is to copy only filled rows in the mentioned range (example: only row 10,15,22,23) and paste it to "Summary_Sheet" one by one - so 4 records from 1st form then 7 records from 2nd form etc. And it should also add the number (from form name) to the column L to each record which was copied from that sheet.
宏应该执行的任务是仅复制上述范围内的填充行(例如:仅行10、15、22、23)并将其粘贴到“ Summary_Sheet”中-如此一来,第1个表格中就有4条记录,然后7记录来自第二个表单等。并且还应该将数字(来自表单名称)添加到从该工作表复制的每个记录的L列中。
Not sure if I am clear enough, but if somebody will have time to help, I will be very grateful. 不知道我是否足够清楚,但是如果有人有时间帮助我,我将非常感激。
edited after OP's clarification about initial input row index: 在OP阐明了有关初始输入行索引之后进行了编辑:
you could try this (commented) code: 您可以尝试以下(注释)代码:
Option Explicit
Sub main()
Dim sht As Worksheet, summarySht As Worksheet
Dim rngToCopy As Range
With Workbooks("Forms") '<--| change "formsWb" to your actual workbook with "FORM_Number" sheets name
Set summarySht = GetOrCreateSheet(.Worksheets, "Summary_Sheet") '<--|get Summary worksheet reference or create it if not already in referenced workbook
For Each sht In .Worksheets '<-- loop through referenced workbook worksheets
With sht '<-- reference current worksheet
If Left(.name, 5) = "FORM_" Then '<-- if its name begins with "FORM_" then...
Set rngToCopy = .Columns(1).SpecialCells(XlCellType.xlCellTypeConstants).EntireRow '<-- set the range of currently referenced worksheet column "A" not blank cell entire row
Set rngToCopy = Intersect(rngToCopy, .Rows("5:" & .UsedRange.Rows(.UsedRange.Rows.Count).row)) '<--| limit it to rows from row 5 downwards
rngToCopy.Copy '<-- copy the above set range
With summarySht '<-- reference Summary worksheet
With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) '<-- get its first blank cell in column "A"
.PasteSpecial '<-- paste the copied range
Application.CutCopyMode = False
.Offset(, 11).Resize(.Parent.Cells(.Parent.Rows.Count, 1).End(xlUp).row - .row + 1).Value = sht.name '<-- paste the current "FORM" worksheet name in column "L" corresponding rows
End With
End With
End If
End With
Next sht
End With
End Sub
Function GetOrCreateSheet(wss As sheets, shtName As String) As Worksheet
With wss
On Error Resume Next
Set GetOrCreateSheet = .Item(shtName)
On Error GoTo 0
If GetOrCreateSheet Is Nothing Then
Set GetOrCreateSheet = .Add
.Parent.ActiveSheet.name = "Summary_Sheet"
End If
End With
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.