尝试使用Excel VBA将行复制/粘贴到行之间,在行之间保存表单

时间:2014-02-25 02:11:29

标签: excel vba excel-vba

我有一个工作簿,作为另一个基于Excel的表单(不是Userform,只是一个格式化的电子表格)的源数据。源文件包含2-40行数据 - 从第18行开始 - 每行需要复制到表单中并单独保存,即源文件中的15行等同于15个不同的表单文件。

必须单独复制行中的每个单元格并将其粘贴到表单上的特定单元格。源表单包含客户端及其相关信息。我试图使用窗体上的宏来自动从源文件中提取行项目,将窗体保存为指定文件夹中的客户端名称,并继续直到源文件上的空行。我有一些基本的VBA经验,但对循环,变量或函数知之甚少,这似乎是我最好的行动方案。

这是我到目前为止所拥有的。我能够完成的是从源文件复制/粘贴第一行。

Range("B18").Select
Selection.Copy
Windows("Form.xls").Activate
Range("F7:K7").Select
ActiveSheet.Paste
Windows("Source.xls").Activate
Range("C18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("D8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Source.xls").Activate
Range("D18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("H29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Source.xls").Activate
Range("E18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("E29").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Source.xls").Activate
Range("F18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Processing Form.xls").Activate
Range("D33").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range(“F7:K7”).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWorkbook.SaveAs

我甚至无法通过客户端的名称来保存我的宏。我也知道我广泛使用“范围”和“选择”会使我的代码慢下来,我只是不知道如何提高它的效率。我已经尝试使用一个引用单元格来告诉宏要复制的源文件的哪一行,但也没有任何运气。任何和所有的帮助将不胜感激!

3 个答案:

答案 0 :(得分:0)

您经常激活工作簿。这是你的代码变慢..下面的代码将更快地工作

Sub test()
Dim dwb As Workbook
Dim swb As Workbook

Set dwb = Workbooks("Form.xls")
Set swb = Workbooks("Source.xls")
Set awb = Workbooks("Processing Form.xls")

    With swb
    .ActiveSheet.Range("B18").Copy Destination:=dwb.Sheet1.Range("F7:K7")
    .ActiveSheet.Range("C18").Copy Destination:=awb.Sheet1.Range("D8")
    .ActiveSheet.Range("D18").Copy Destination:=awb.Sheet1.Range("H29")
    .ActiveSheet.Range("e18").Copy Destination:=awb.Sheet1.Range("E29")
    .ActiveSheet.Range("F18").Copy Destination:=awb.Sheet1.Range("D33")
    End With

    End Sub

答案 1 :(得分:0)

这可能有助于引导您朝着正确的方向前进:

Dim i As Long
For i = 1 To 10
    With Range("A" & i)
        .Copy Workbooks("ToWorkbook.xlsx").Worksheets("Sheet1").Range("B" & i + 9)
        .Copy Workbooks("ToAnother.xlsx").Worksheets("Sheet2").Range("C" & i + 8)
        .Copy Workbooks("AnotherOne.xlsx").Worksheets("SheetA").Range("D" & i + 2)
    End With
Next i

i To 10用作循环源工作簿中的行的计数器。 对于每个i,您将从A列中取出范围(即with这个,做一些事情),将其复制并粘贴到不同工作簿中的不同单元格中。在第一轮中,范围(“A1”)分别被复制到范围(“B10”),范围(“C9”)和范围(“D3”)的3个不同的工作簿中。下一轮,源书中的范围(“A2”)将从上次复制并粘贴到相同的目标工作簿中,但是在范围(“B11”),范围(“C10”)和范围(“D4”中“)。只需找到您需要粘贴的不同表单的模式即可。

答案 2 :(得分:0)

这是一个简单的演示:

注意:未经测试

Option Explicit

Sub CopyToForm()

Dim wbSource As Workbook, wbForm As Workbook
Dim wsSource As Worksheet, wsForm As Worksheet
Dim formpath As String, foldertosavepath as string
Dim lrow As Long, i As Integer

Set wbSource = Thisworkbook '~~> assuming you write your code in Source.xls
Set wsSource = wbSource.Sheets("NameOfYourSheet") '~~> put the source sheet name

'~~> put the path where your form template is saved here
formpath = "C:\Users\Username\FolderName\Processing Form.xls"
'~~> put the path where you want to save individual updated forms.
foldertosavepath = "C:\Users\Username\FolderDestination\"

With wsSource
    '~~> get the number of rows with data
    lrow = .Range("B" & .Rows.Count).End(xlUp).Row
    If lrow < 18 Then Msgbox "No data for transfer": Exit Sub
    For i = 18 to lrow
        Set wbForm = Workbooks.Open(formpath) '~~> open the form
        Set wsForm = wbForm.Sheets("Sheetname") '~~> put the form sheet name
        '~~> proceed with the copying
        .Range("B" & i).Copy: wsForm.Range("F7:K7").PasteSpecial xlPasteValue
        .Range("C" & i).Copy: wsForm.Range("D8").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
        '~~> Save the form using the client name, I assumed it is in B?
        wbForm.SaveAs foldertosavepath & .Range("B" & i).Value & ".xls"
        wbForm.Close True
        Set wbForm = Nothing
        Set wsForm = Nothing
   Next
End With

End Sub

在上面的代码中,我假设Form.xlsProcessing Form.xls相同 这应该给你逻辑 我希望这是你的开始。
这不是我所记录的测试,因此如果您遇到错误,请将其注释掉。