我很难尝试浏览工作簿中的每个工作表，从另一个工作簿中获取工作表的名称并重命名我的主工作簿工作表。所以，现在我已经拥有它，以便用户可以选择他们想要复制的文件到具有不同布局的新工作簿，然后是他们使用的旧工作簿。然后它获取旧工作簿中有多少工作表的计数，并将工作表复制到新（主）工作簿中。然后，它获取每个选项卡的名称，并在新（主）工作簿中重命名工作表。
在代码的这个区域主要遇到麻烦
For i = 1 To sheetcounts
wbCopyTo.Activate
wsCopyTo.Copy After:=ActiveSheet
wbCopyTo.Worksheets(1).Activate
'wbCopyFrom.Sheets(ActiveSheet.Index + 1).Select
wbCopyFrom.ActiveSheet.Next.Activate
wbCopyTo.ActiveSheet.Name = wbCopyFrom.ActiveSheet.Name
这是整件事
`Sub CpyOldTest()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim cCounter As Integer
Dim rCounter As Integer
Dim sheetcounts As Integer
Dim i As Integer
Set wbCopyTo = ThisWorkbook
Set wsCopyTo = ActiveSheet
'On Error Resume Next
'-------------------------------------------------------------
'Open file with data to be copied
vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)
'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(Sheets.Count)
'Get Count and Copy
sheetcounts = wbCopyFrom.Worksheets.Count - 1
For i = 1 To sheetcounts
wbCopyTo.Activate
wsCopyTo.Copy After:=ActiveSheet
wbCopyTo.Worksheets(1).Activate
'wbCopyFrom.Sheets(ActiveSheet.Index + 1).Select
wbCopyFrom.ActiveSheet.Next.Activate
wbCopyTo.ActiveSheet.Name = wbCopyFrom.ActiveSheet.Name
'Copy Range
Application.ScreenUpdating = False
'Patient Information
wsCopyFrom.Range("B2:B10").Copy
wsCopyTo.Range("B2:B10").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Physician and Home Health care
wsCopyFrom.Range("C12:C17").Copy
wsCopyTo.Range("C12:C17").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Diagnosis/TPN/Assessment Type
wsCopyFrom.Range("B19:D21").Copy
wsCopyTo.Range("B19:D21").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Calculated Needs
wsCopyFrom.Range("E5").Copy
wsCopyTo.Range("E5").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("E7").Copy
wsCopyTo.Range("E7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("E9:E10").Copy
wsCopyTo.Range("E9:E10").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("E12:E14").Copy
wsCopyTo.Range("E12:E14").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Intake/Lipids
wsCopyFrom.Range("B23:C28").Copy
wsCopyTo.Range("B23:C28").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'TPN Components
wsCopyFrom.Range("C30:C37").Copy
wsCopyTo.Range("C30:C37").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'IBW adjustment
wsCopyFrom.Range("F1").Copy
wsCopyTo.Range("F1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Protein Needs
'wsCopyFrom.Range("F12").Copy
'wsCopyTo.Range("F12").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Notes
wsCopyFrom.Range("E19:F23").Copy
wsCopyTo.Range("E19:F23").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Intake
wsCopyFrom.Range("D23").Copy
wsCopyTo.Range("D23").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Amino Acid
wsCopyFrom.Range("D25").Copy
wsCopyTo.Range("D25").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Total MLs
wsCopyFrom.Range("D27").Copy
wsCopyTo.Range("D27").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'KCal
wsCopyFrom.Range("D29").Copy
wsCopyTo.Range("D29").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'IV/Lipid/Fluid Bags
wsCopyFrom.Range("E25:E27").Copy
wsCopyTo.Range("E25:E27").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Access Device
wsCopyFrom.Range("F29:F30").Copy
wsCopyTo.Range("F29:F30").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Lab Frequency
wsCopyFrom.Range("F33").Copy
wsCopyTo.Range("F32").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'-------------------------------------------------------------------
'Lab Data
wsCopyFrom.Range("J2:P12").Copy
wsCopyTo.Range("J2:P12").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("J14:P32").Copy
wsCopyTo.Range("J14:P32").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("G4:H32").Copy
wsCopyTo.Range("G4:H32").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("I25:I32").Copy
wsCopyTo.Range("I25:I32").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'TPN
wsCopyFrom.Range("K34:P41").Copy
wsCopyTo.Range("K37:P44").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("K43:P50").Copy
wsCopyTo.Range("K46:P53").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'------------------------------------------------------------------
'Additives
wsCopyFrom.Range("B39:F39").Copy
wsCopyTo.Range("B42:F42").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Subjective
wsCopyFrom.Range("A41:F47").Copy
wsCopyTo.Range("A44:F50").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Meds
wsCopyFrom.Range("A50:F50").Copy
wsCopyTo.Range("A53:F53").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Assessment Diagnosis
wsCopyFrom.Range("A53:F56").Copy
wsCopyTo.Range("A56:F59").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Nutrition Goals
wsCopyFrom.Range("A59:F63").Copy
wsCopyTo.Range("A62:F66").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Plan of Care
wsCopyFrom.Range("A66:F72").Copy
wsCopyTo.Range("A69:F75").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'------------------------------------------------------------------
'List of Dietitians
wsCopyFrom.Range("K62:P67").Copy
wsCopyTo.Range("K65:P70").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Dates
wsCopyFrom.Range("C73:C74").Copy
wsCopyTo.Range("C76:C77").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Education
wsCopyFrom.Range("B75:H75").Copy
wsCopyTo.Range("B78:H78").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Discussed
wsCopyFrom.Range("B76:D76").Copy
wsCopyTo.Range("B79:D79").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Dietitian
wsCopyFrom.Range("A79:B80").Copy
wsCopyTo.Range("A82:B82").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Evaluation
wsCopyFrom.Range("D79:E79").Copy
wsCopyTo.Range("D82:E82").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Pharmacy Information
wsCopyFrom.Range("B86:D87").Copy
wsCopyTo.Range("B89:D90").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("B88:B89").Copy
wsCopyTo.Range("B91:B92").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Next due dates
wsCopyFrom.Range("G86:G89").Copy
wsCopyTo.Range("G89:G92").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
'Close file that was opened
wbCopyFrom.Close SaveChanges:=False
Application.ScreenUpdating = True
End If
End Sub
我已经尝试了很多方法来通过这个但仍然没有运气。只是想知道我是否可以在这里得到一些帮助。很抱歉代码的错误布局只是试图在我清理之前完成这项工作。谢谢。
答案 0 :(得分：0)
没有理由激活纸张。
创建一个复制模板的函数，并返回对新工作表的引用。
For each ws in Worksheets优于For i = 1 to Worksheets.Count
如果您只想复制连续范围的值，最好直接分配Range("B1:B10").Value =范围（＆＃34; A1：A10＆＃34;）。VAlue as opposed to范围（＆＃34; A1：A10＆＃34;）。复制：Range("B1:B10").PasteSpecial xlPasteValues
Worksheets集合从索引1开始。此循环发送最后一个工作表。
sheetcounts = wbCopyFrom.Worksheets.Count - 1
Set wsCopyFrom = wbCopyFrom.Worksheets(Sheets.Count)
Sub CpyOldTest()
Dim vFile As Variant
Dim wbCopyFrom As Workbook, wsTemplate As Workbook
Dim ws As Worksheet
'On Error Resume Next
Set wsTemplate = ThisWorkbook.Worksheets("Template")
'-------------------------------------------------------------
'Open file with data to be copied
vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)
'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Application.ScreenUpdating = False
Set wbCopyFrom = Workbooks.Open(vFile)
For Each ws In wbCopyFrom.Worksheets
With getTemplateCopy
.Name = ws.Name
.Range("B2:B10").Value = ws.Range("B2:B10").Value 'Patient Information
.Range("C12:C17").Value = ws.Range("C12:C17").Value 'Physician and Home Health care
.Range("B19:D21").Value = ws.Range("B19:D21").Value 'Diagnosis/TPN/Assessment Type
'-------------------------------------------------------------------
'Calculated Needs
.Range("E5").Value = ws.Range("E5").Value
.Range("E7").Value = ws.Range("E7").Value
.Range("E9:E10").Value = ws.Range("E9:E10").Value
.Range("E12:E14").Value = ws.Range("E12:E14").Value
'-------------------------------------------------------------------
.Range("B23:C28").Value = ws.Range("B23:C28").Value 'Intake/Lipids
.Range("C30:C37").Value = ws.Range("C30:C37").Value 'TPN Components
.Range("F1").Value = ws.Range("F1").Value 'IBW adjustment
'.Range("F12").value = ws.Range ("F12").value 'Protein Needs
.Range("E19:F23").Value = ws.Range("E19:F23").Value 'Notes
'-------------------------------------------------------------------
.Range("D23").Value = ws.Range("D23").Value 'Intake
.Range("D25").Value = ws.Range("D25").Value 'Amino Acid
.Range("D27").Value = ws.Range("D27").Value 'Total MLs
.Range("D29").Value = ws.Range("D29").Value 'KCal
.Range("E25:E27").Value = ws.Range("E25:E27").Value 'IV/Lipid/Fluid Bags
.Range("F29:F30").Value = ws.Range("F29:F30").Value 'Access Device
.Range("F32").Value = ws.Range("F33").Value 'Lab Frequency
'-------------------------------------------------------------------
'Lab Data
.Range("J2:P12").Value = ws.Range("J2:P12").Value
.Range("J14:P32").Value = ws.Range("J14:P32").Value
.Range("G4:H32").Value = ws.Range("G4:H32").Value
.Range("I25:I32").Value = ws.Range("I25:I32").Value
.Range("K37:P44").Value = ws.Range("K34:P41").Value 'TPN
.Range("K46:P53").Value = ws.Range("K43:P50").Value
'------------------------------------------------------------------
.Range("B42:F42").Value = ws.Range("B39:F39").Value 'Additives
.Range("A44:F50").Value = ws.Range("A41:F47").Value 'Subjective
.Range("A53:F53").Value = ws.Range("A50:F50").Value 'Meds
.Range("A56:F59").Value = ws.Range("A53:F56").Value 'Assessment Diagnosis
.Range("A62:F66").Value = ws.Range("A59:F63").Value 'Nutrition Goals
.Range("A69:F75").Value = ws.Range("A66:F72").Value 'Plan of Care
'------------------------------------------------------------------
.Range("K65:P70").Value = ws.Range("K62:P67").Value 'List of Dietitians
.Range("C76:C77").Value = ws.Range("C73:C74").Value 'Dates
.Range("B78:H78").Value = ws.Range("B75:H75").Value 'Education
.Range("B79:D79").Value = ws.Range("B76:D76").Value 'Discussed
.Range("A82:B82").Value = ws.Range("A79:B80").Value 'Dietitian
.Range("D82:E82").Value = ws.Range("D79:E79").Value 'Evaluation
'------------------------------------------------------------------
'Pharmacy Information
.Range("B89:D90").Value = ws.Range("B86:D87").Value
.Range("B91:B92").Value = ws.Range("B88:B89").Value
'------------------------------------------------------------------
.Range("G89:G92").Value = ws.Range("G86:G89").Value 'Next due dates
End With
Next
'Close file that was opened
wbCopyFrom.Close SaveChanges:=False
Application.ScreenUpdating = True
End If
End Sub
Function getTemplateCopy() As Worksheet
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Template")
ws.Copy After:=ws
Set getTemplateCopy = ThisWorkbook.ActiveSheet
End Function