基于条件将宏复制到新的工作簿 [英] Macro to copy range to new workbook based on condition
问题描述
可能重复:
宏将范围复制到新工作簿条件
我已经尝试创建一个宏,用于以下目的:将工作簿的范围复制到新的工作簿。看一下示例1中的第一个屏幕截图,我想要实现的是将范围R4:AB6复制到新的工作簿,并附加一些标准。宏应该只复制活动单元格行包含值的行。示例1的第二个屏幕截图显示了宏的结果是:基于所提到的标准,具有粘贴范围的新工作簿。我又增加了一个例子,使我需要更清楚。在示例2中,屏幕截图2显示活动单元是R7的起始位置。运行宏的结果将是最后的屏幕截图,其中第4行和第5行已经与活动单元格的行一起复制,并且只有当该行不为空时。
I have unsuccesfully been trying to create a macro for the following purpose: copy a range of a workbook to a new workbook. Looking at the first screenshot in example 1, what I would like to achieve is to copy range R4:AB6 to a new workbook, with an additional criteria. The macro should only copy the rows where the row of the active cell contains values. The second screenshot of example 1 displays what the outcome of the macro would be: a new workbook with the pasted range based on the criteria mentioned. I have added another example to make what I need more clear. In example 2, screenshot 2 displays the starting position where the active cell is R7. The outcome of running the macro would be the final screenshot, where rows 4 and 5 have been copied along with the row of the active cell, and only if that row is not empty.
我真的很感激任何帮助,因为我对vba很新,并且在这个时间已经很久了!
I would truly appreciate any help, as I am rather new to vba and have been breaking my head on this one for a very long time!
推荐答案
这是很原始的,但希望这有助于..
It's pretty crude, but hopefully this helps..
Sub bks()
Application.ScreenUpdating = False
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim name1 As String
Dim name2 As String
Dim colLet As String
'grab name of current workbook
name1 = ThisWorkbook.Name
Set WB1 = Workbooks(name1)
'create new workbook and set it
Workbooks.Add.Activate
name2 = ActiveWorkbook.Name
Set WB2 = Workbooks(name2)
WB1.Activate
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim mAdjust As Integer
Dim x As Double
'set x equal to number of rows you have
x = 100
Dim colSave() As Double
ReDim colSave(x)
j = 1
k = 1
'the `17` adjust the loop for the R column (17 columns over from 1)
For i = 1 + 17 To 11 + 17
For m = 1 To x
'for each row of records, set the first report column to 1 via the array colSave(m)
If i = 1 + 17 Then
colSave(m) = 1
End If
mAdjust = m + 5
WB2.Activate
j = colSave(m)
'convert the column number to column letter
If i > 26 Then
colLet = Chr(Int((i - 1) / 26) + 64) & Chr(Int((i - 1) Mod 26) + 65)
Else
colLet = Chr(i + 64)
End If
WB1.Activate
'the conditional statements you wanted
If Cells(mAdjust, i) <> "" Then
Range(colLet & "4," & colLet & "5," & colLet & mAdjust).Activate
Selection.Copy
WB2.Activate
Sheets("Sheet1").Cells((m - 1) * 5 + 1, j).Activate
ActiveSheet.Paste
colSave(m) = colSave(m) + 1
End If
Next m
Next i
Application.ScreenUpdating = True
WB2.Activate
'`j` and `k` allow you to move the paste columns sperately based on your condition.
End Sub
这篇关于基于条件将宏复制到新的工作簿的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!