[英]Trying to use Excel VBA to copy/paste rows onto form, saving form in between rows
[英]Trying to use Excel VBA to skip blank rows in my copy/paste loop
我在Excel文件中有一个订单项的复制/粘贴循环,可将这些订单项中的数据导出到基于Excel的表单中,并按行B中的值保存每个表单。我的问题是,这些订单项分为3种同一张纸上的表格,每个表格都有不同数量的要复制的订单项。 此外,每个表由2个空白行分隔。
我需要宏为我做什么:
当我删除大量代码以提高可读性时,请忽略某些声明。 我认为我需要3个单独的复制/粘贴循环来完成此操作(这里仅包括2个),并且尝试使用.Find引用第二个/第三个表的开始。 宏在第一个表中正常运行,但是在遇到空白行时不会停止,而在尝试根据空单元格的值保存文件时会失败。 我相信问题在于EndOne = .Range("B" & .Rows.Count).End(xlUp).Row
变量位于With wsSource
。 它不计算第一张表的非空白行,而是计算到第三张表的末尾的行数。
Sub CopyToForm()
Dim wbSource As Workbook, wbForm As Workbook
Dim wsSource As Worksheet, wsForm As Worksheet
Dim formpath As String, foldertosavepath As String
Dim EndOne As Long, EndTwo As Long, EndThree As Long, i As Integer
Dim strProcessingFormPath As String
'Dim strCancel As String
'Dim strFilt As String
'Dim intFilterIndex As Integer
'Dim strDialogueFileTitle As String
Dim SecondTable As String
Dim ThirdTable As String
Set wbSource = ThisWorkbook '~~> Write your code in Indication Tool.xls
Set wsSource = wbSource.Sheets("Indication Tool") '~~> Put the source sheet name
With wsSource
'~~> Counts how many rows are in the Indication Tool
EndOne = .Range("B" & .Rows.Count).End(xlUp).Row
If EndOne < 17 Then MsgBox "No data for transfer": Exit Sub
For i = 17 To EndOne
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
'~~> Proceed with the copying / pasting of values
.Range("B" & i).Copy wsForm.Range("F7:K7")
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
.Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
.Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
.Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
.Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
'.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
'~~> Save the form using the value in cell i,B
wbForm.SaveAs .Range("B" & i).Value & ".xls"
wbForm.Close
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
With wsSource
SecondTable = .Range("B:B").Find("SecondTable").Row
EndTwo = .Range("B" & .Rows.Count).End(xlUp).Row
For i = Second Table + 1 To EndTwo
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
'~~> Proceed with the copying / pasting of values
.Range("B" & i).Copy wsForm.Range("F7:K7")
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
.Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
.Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
.Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
.Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
'~~> Save the form using the cells i,B
wbForm.SaveAs .Range("B" & i).Value & ".xls"
wbForm.Close
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
End Sub
.Find和每个表的单独复制/粘贴循环是否在正确的轨道上? 我意识到这是一个复杂的问题,感谢您抽出宝贵时间来帮助我。
.Find和每个表的单独复制/粘贴循环是否在正确的轨道上?
不完全是。 这些循环内的代码基本相同,因此是子例程的理想选择。 这将使您的代码更易于阅读,并且维护起来也更容易,因为只有一个地方可以进行修订,而不是多个地方(想象一下,如果您需要进行10次不同的迭代或1,000次,那么您就不会可能编写1,000个不同的循环来执行相同的操作!!)
可以考虑一下(我观察到一些会纠正的明显错误,但这未经测试)。 我所做的就是将您的多个循环合并到一个子例程中。 然后,我们向该子例程发送一些信息,例如表的开始和结束位置:
Sub CopyStuff(ws as Worksheet, tblStart as Long, tblEnd as Long)
我们将发送它: wsSource
,并将使用/重复使用其他变量来确定每个表的开始/结束。 我删除了多余的变量(除非它们需要在其他地方重复使用,没有两个变量EndOne
和EndTwo
是不必要的:我们可以利用tblStart
和tblEnd
类的通用变量,可以将它们重新分配给后续表。
通过这种方式,很明显我们以相同的方式处理多个表。 如果将来需要更改代码,则也只有一个For i = ...
循环可以管理。 因此,它更易于理解和维护。
Sub CopyToForm()
Dim wbSource As Workbook 'No longer needed in this context: wbForm As Workbook
Dim wsSource As Worksheet 'No longer needed in this context: wsForm As Worksheet
Dim formpath As String, foldertosavepath As String
Dim tblEnd As Long, tblStart As Long, i As Integer
Dim strProcessingFormPath As String
Dim tblStart as Integer: tblStart = 16
Set wbSource = ThisWorkbook '~~> Write your code in Indication Tool.xls
Set wsSource = wbSource.Sheets("Indication Tool") '~~> Put the source sheet name
With wsSource
'~~> Counts how many rows are in the Indication Tool
tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
If tblEnd < 17 Then GoTo EarlyExit '## I like to use only one exit point from my subroutines/functions
CopyStuff wsSource, tblStart, tblEnd
tblStart = .Range("B:B").Find("SecondTable").Row + 1
tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
CopyStuff wsSource, tblStart, tblEnd
'And presumably...
tblStart = .Range("B:B").Find("ThirdTable").Row + 1
tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
CopyStuff wsSource, tblStart, tblEnd
End With
Exit Sub
EarlyExit:
MsgBox "No data for transfer"
End Sub
Private Sub CopyStuff(ws As Worksheet, tblStart as Long, tblEnd as Long)
Dim wbForm as Workbook, wsForm as Worksheet, i As Long
With ws
For i = tblStart to tblEnd
Set wbForm = Workbooks.Open(formpath) '~~> open the form
Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
'~~> Proceed with the copying / pasting of values
.Range("B" & i).Copy wsForm.Range("F7:K7")
.Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
.Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
.Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
.Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
.Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
.Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
.Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
.Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
.Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
'.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
'~~> Save the form using the value in cell i,B
wbForm.SaveAs .Range("B" & i).Value & ".xls"
wbForm.Close
Set wbForm = Nothing
Set wsForm = Nothing
Next
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.