各ワークシートに戻ることなく移動する

ワークブック内の各ワークシートを調べたり、別のワークブックからワークシート名を取得したり、メインワークブックワークシートの名前を変更したりするのは苦労しています。それで、今、私はそれを持っているので、ユーザーは、彼らが使用した古いものとは異なるレイアウトの新しいブックにコピーしたいファイルを選択することができます。次に、古いワークブックに含まれるワークシートの数を取得し、新しい（メイン）ワークブックにワークシートをコピーします。その後、各タブの名前が取得され、新しい（メイン）ワークブックでワークシートの名前が変更されます。ほとんどがここでコード各ワークシートに戻ることなく移動する

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

です。私はここでいくつかの助けを得ることができますか？私はそれをクリーンアップする前に、これを行うためにしようとしているコードの悪いレイアウトについては申し訳ありません。ありがとうございました。

出典

2016-11-29 Rafael Clemente

あなたは本当に*実際の問題*が何であるかは述べていません。特定の問題を知らなくても助けが難しい。 –

Scottが言ったように、私たちは推測することができます。ここには、あなたがコピーしているワークシートの多くが同じ名前を持っていればどうでしょうか？ –

@Scott Holtzmanこんにちは、ごめんなさい。私は思った。コードを実行すると、古いブックから各シートの名前を取得し、それらの名前の新しいブックに新しいシートを作成する必要があります。また、各ワークシートの情報を新しいワークブックの新しいシートにコピーする必要があります。 –

シートを有効にする理由はありません。

テンプレートをコピーし、新しいワークシートへの参照を返す関数を作成します。

For each ws in Worksheetsあなただけの連続した範囲の値をコピーしたい場合は、直接割り当てRange("B1:B10").Value =範囲（「A1：A10」）を行う方が良いですFor i = 1 to Worksheets.Count

以上が望ましい。値as opposed to範囲（ "A1 ：A10 "）コピー：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

出典

2016-11-29 23:08:32

ありがとう、私はこれを試してみます。ワークロードを 'i = 1 To Worksheets.count'と' ws in wbCopyFrom'で分割することを考えていました。 –

各ワークシートに戻ることなく移動する

答えて

関連する問題