复制特定范围,从一个Excel文件并将其分配到另一个工作簿中的适当床单中



我在"源"文件中有一个表,范围:ag5:an5,ag6:an6 ... ag16:an16,我的任务是复制这些数据并将其粘贴到在另一个"目的地"工作簿中有12张床单的适当床单。每个表都有名称。尽管源工作簿中的范围没有变化,但其中包含的数据每天都会更改。因此,这些数据不应在一个固定单元格中复制,而应基于最后填充的单元格向下滑动。目标文件中的复制范围将从" C6"启动,然后向下启动。我确实记录了宏并进行了小更正,但问题是,执行此任务时,将多次激活工作簿,并且具有闪烁的效果。是否可以在此示例中使用循环?如何避免在拷贝性操作过程中激活工作簿?

" GL Rate Counculation.xlsm" - 源文件
" dpr_als_september_2017.xlsx" - 目标文件

这是我的代码:

Sub GL_DPR_FillIn()
    Range("AG5:AN5").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch24").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG6:AN6").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch30").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG7:AN7").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch54").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG8:AN8").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch56").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG9:AN9").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch60 ").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG10:AN10").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch62").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG11:AN11").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch65").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG12:AN12").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch67").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG13:AN13").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch117").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG14:AN14").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch123").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG15:AN15").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch51").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
    Range("AG16:AN16").Select
    Selection.Copy
    Windows("DPR_ALS_September_2017.xlsx").Activate
    Sheets("Ch124").Select
    lastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    ActiveSheet.Range("C" & lastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    Windows("GL Rates Calculation.xlsm").Activate
End Sub

尝试一下,让我知道您是否有问题。

Sub GL_DPR_FillIn()
Dim wbA As Workbook
Dim wbB As Workbook
Dim wsName, lastRow
Dim j
Set wbA = Workbooks("GL Rates Calculation.xlsm") 'This one should already be open
Set wbB = Workbooks.Open("C:pathnameDPR_ALS_September_2017.xlsx")  'Open the destination workbook
For j = 5 To 16 Step 1
    wbA.Worksheets("GL").Range("AG" & j & ":" & "AN" & j).Copy
        If j = 5 Then wsName = "Ch24"
        If j = 6 Then wsName = "Ch30"
        If j = 7 Then wsName = "Ch54"
        If j = 8 Then wsName = "Ch56"
        If j = 9 Then wsName = "Ch60"
        If j = 10 Then wsName = "Ch62"
        If j = 11 Then wsName = "Ch65"
        If j = 12 Then wsName = "Ch67"
        If j = 13 Then wsName = "Ch117"
        If j = 14 Then wsName = "Ch123"
        If j = 15 Then wsName = "Ch51"
        If j = 16 Then wsName = "Ch124"

       lastRow = Worksheets(wsName).Cells(Rows.Count, "C").End(xlUp).Row
       Worksheets(wsName).Range("C" & lastRow + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
    Application.CutCopyMode = False
    Next j
'To Close the Destination Workbook, uncomment the following line
'wbB.Close
End Sub

相关内容

最新更新