你能帮我解决一下我的VB代码问题，它会将excel文件的特定标签（源工作簿：工作表1）中的命名范围复制到另一个excel文件（目标工作簿：工作表1）中的同一个命名选项卡吗？我需要使用for循环或每个语句来复制多个选项卡。选项卡以数字命名（例如，1,2,4,7等），如您所见，它可能会跳过一个数字，因此n = n + 1可能不起作用。此外，根据给定时段的用户输入（例如，2013年第1季度，2013年第2季度，2013年第3季度，2013年第3季度），要复制的指定范围或范围数据会有所不同。
您可以添加的任何效率都非常受欢迎。
谢谢！ 安
Dim wbTarget As Excel.Workbook 'target workbook; tabs: Notes, Input, Summary, 1, 2, 4, 7
Dim wbSource As Excel.Workbook 'source workbook; tabs: Notes, 1, 2, 4, 7, Misc
Dim wsTarget As Excel.Worksheet 'worksheet where the data is to be pasted (eg. 1, 2, 4, 7)
Dim wsSource As Excel.Worksheet 'worksheet from where the data is to copied (eg. 1, 2, 4, 7)
Dim TrgName As String 'name of the target workbook tab
Dim SrcName As String 'name of the source workbook tab
Dim s As Integer 'counter used for each tabs (eg. 1, 2, 4, 7)
Dim period As String 'qtr period
Dim year As Integer 'current year report
Dim qtr As Integer 'current qtr report
Dim first As Long
Dim last As Long
Dim RowQ1 As Long, RowQ2 As Long, RowQ3 As Long, RowQ4 As Long
Dim ColQ1 As Long, ColQ2 As Long, ColQ3 As Long, ColQ4 As Long
'select the Qtr Period to report
period = "Q4"
year = 2013
'set the following for use in range names
'e.g. for tab 1
' Q1 = Range("'1'!A1:CB200")
' Q2 = Range("'1'!A250:CB300")
' Q3 = Range("'1'!A350:CB400")
' Q4 = Range("'1'!A450:CB500")
RowQ1 = 1
RowQ2 = 250
RowQ3 = 350
RowQ4 = 450
ColQ1 = 200
ColQ2 = 300
ColQ3 = 400
ColQ4 = 500
first = 1
last = 80
'set to the current active workbook (the source book)
Set wbSource = ActiveWorkbook
Set wbTarget = Workbooks.Open("C:\Users\temp\targetfile_" & year & period & ".xlsx")
'set counter to each tab; as long as the source name is not equal to "Notes", the loop should continue ---- I'm just not sure how to handle the target workbook and each worksheet
s = 1
For Each wsSource In Worksheets
If wsSource.Name <> "Notes" And period = "Q1" Then 'For Q1 Period
SrcName = wsSource.Name
Worksheets("Notes").Cells(counter, 1).Value = SrcName
wsSource.Activate
Application.CutCopyMode = False
wsSource.Range(Cells(RowQ1, first), Cells(ColQ1, last)).Copy
TrgName = SrcName
wbTarget.Activate
wsTarget.Name = TrgName
wsTarget.Range(Cells(RowQ1, first)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ElseIf wsSource.Name <> "Notes" And period = "Q2" Then 'For Q2 Period
SrcName = wsSource.Name
Worksheets("Notes").Cells(counter, 1).Value = SrcName
wsSource.Activate
Application.CutCopyMode = False
wsSource.Range(Cells(RowQ2, first), Cells(ColQ2, last)).Copy
TrgName = SrcName
wbTarget.Activate
wsTarget.Name = TrgName
wsTarget.Range(Cells(RowQ2, first)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ElseIf wsSource.Name <> "Notes" And period = "Q3" Then 'For Q3 Period
SrcName = wsSource.Name
Worksheets("Notes").Cells(counter, 1).Value = SrcName
wsSource.Activate
Application.CutCopyMode = False
wsSource.Range(Cells(RowQ3, first), Cells(ColQ3, last)).Copy
TrgName = SrcName
wbTarget.Activate
wsTarget.Name = TrgName
wsTarget.Range(Cells(RowQ3, first)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
ElseIf wsSource.Name <> "Notes" And period = "Q4" Then 'For Q4 Period
SrcName = wsSource.Name
Worksheets("Notes").Cells(counter, 1).Value = SrcName
wsSource.Activate
Application.CutCopyMode = False
wsSource.Range(Cells(RowQ4, first), Cells(ColQ4, last)).Copy
TrgName = SrcName
wbTarget.Activate
wsTarget.Name = TrgName
wsTarget.Range(Cells(RowQ4, first)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
s = s + 1
End If
Next wsSource
'save the target book
wbTarget.Save
'close the workbook
wbTarget.Close
'activate the source book again
wbSource.Activate
'clear memory
Set wbTarget = Nothing
Set wbSource = Nothing
End Sub
答案 0 :(得分：1)
我不确定你遇到了什么问题。至于效率。您运行相同的代码块四次。你可以做这样的事情，使代码更容易维护。
Dim wbTarget As Excel.Workbook 'target workbook; tabs: Notes, Input, Summary, 1, 2, 4, 7
Dim wbSource As Excel.Workbook 'source workbook; tabs: Notes, 1, 2, 4, 7, Misc
Dim wsTarget As Excel.Worksheet 'worksheet where the data is to be pasted (eg. 1, 2, 4, 7)
Dim wsSource As Excel.Worksheet 'worksheet from where the data is to copied (eg. 1, 2, 4, 7)
Dim TrgName As String 'name of the target workbook tab
Dim SrcName As String 'name of the source workbook tab
Dim s As Integer 'counter used for each tabs (eg. 1, 2, 4, 7)
Dim period As String 'qtr period
Dim year As Integer 'current year report
Dim qtr As Integer 'current qtr report
Dim first As Long
Dim last As Long
Dim RowQ1 As Long, RowQ2 As Long, RowQ3 As Long, RowQ4 As Long
Dim ColQ1 As Long, ColQ2 As Long, ColQ3 As Long, ColQ4 As Long
Sub start()
'select the Qtr Period to report
period = "Q4"
year = 2013
'set the following for use in range names
'e.g. for tab 1
' Q1 = Range("'1'!A1:CB200")
' Q2 = Range("'1'!A250:CB300")
' Q3 = Range("'1'!A350:CB400")
' Q4 = Range("'1'!A450:CB500")
RowQ1 = 1
RowQ2 = 250
RowQ3 = 350
RowQ4 = 450
ColQ1 = 200
ColQ2 = 300
ColQ3 = 400
ColQ4 = 500
first = 1
last = 80
'set to the current active workbook (the source book)
Set wbSource = ActiveWorkbook
Set wbTarget = Workbooks.Open("C:\Users\temp\targetfile_" & year & period & ".xlsx")
'set counter to each tab; as long as the source name is not equal to "Notes", the loop should continue ---- I'm just not sure how to handle the target workbook and each worksheet
s = 1
For Each wsSource In Worksheets
If wsSource.Name <> "Notes" And period = "Q1" Then 'For Q1 Period
Call work(RowQ1, ColQ1, s)
ElseIf wsSource.Name <> "Notes" And period = "Q2" Then 'For Q2 Period
Call work(RowQ2, ColQ2, s)
ElseIf wsSource.Name <> "Notes" And period = "Q3" Then 'For Q3 Period
Call work(RowQ3, ColQ3, s)
ElseIf wsSource.Name <> "Notes" And period = "Q4" Then 'For Q4 Period
Call work(RowQ4, ColQ4, s)
End If
s = s + 1
Next wsSource
'save the target book
wbTarget.Save
'close the workbook
wbTarget.Close
'activate the source book again
wbSource.Activate
'clear memory
Set wbTarget = Nothing
Set wbSource = Nothing
End Sub
Sub work(rq As Integer, cq As Integer, s as integer)
SrcName = wsSource.Name
Worksheets("Notes").Cells(s, 1).Value = SrcName
wsSource.Activate
Application.CutCopyMode = False
wsSource.Range(Cells(rq, first), Cells(cq, last)).Copy
wbTarget.Activate
wsTarget.Name = SrcName
wsTarget.Range(Cells(rq, first)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub
这可能会做得更好，只是一个例子。
也许你可以多解释一下你的问题？