परिवर्तनीय नाम के साथ कार्यपुस्तिकाएं के बीच कॉपी

वोट
0

मैं एक से दूसरे खुला कार्यपुस्तिका से प्रतिलिपि बनाना / मूल्यों पेस्ट का प्रयास कर रहा हूँ। न तो की कार्यपुस्तिका स्थिर नाम होगा, इसलिए कोई नाम स्थिरता हो जाएगा। मेरी कार्यपुस्तिका के दोनों खुला होगा और केवल खुली फ़ाइलों हो जाएगा।

किसी को मदद के लिए मुझे जब मैं फ़ाइल नाम पता नहीं है काम के लिए इस कोड को ठीक कर सकते हैं?

Range(M7:R19).Select
Selection.Copy
Windows(new template.xlsm).Activate
Range(M7).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows(old template.xlsm).Activate
Range(S7:AT16).Select
Application.CutCopyMode = False
Selection.Copy
Windows(new template.xlsm).Activate
Range(U7).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
13/01/2020 को 23:58
का स्रोत उपयोगकर्ता
अन्य भाषाओं में...                            


2 जवाब

वोट
1

आप दो बनाना होगा Workbookचर, एक है कि आप प्रतिलिपि बनाना चाहते बीच distinquish करने से और जहां आप चिपकाना चाहते हैं करने के लिए । तो कुछ आप होगा आरंभ करने के लिए (के बाद से इनमें से केवल दो कार्यपुस्तिका हैं रन-टाइम पर खोलने के लिए):

Sub Test()

Dim ws As Workbook, wbCopy As Workbook, wsPaste As Workbook

For Each wb In Application.Workbooks
    If IsNumeric(Right(wb.Name, 1)) Then
        Set wbCopy = wb
    Else
        Set wbPaste = wb
    End If
Next wb

'Continue coding... Below is just an option:
wbPaste.Worksheets(1).Range("U7:AV16").Value = wbCopy.Worksheets(1).Range("S7:AT16").Value
'Same thing for other ranges....  

End Sub

कोड के दूसरे भाग पर विचार करने के लिए है। मुझे नहीं पता है जो चादर या तो आप कार्यपुस्तिका पर देखें, और न ही मैं जानता हूँ कि यदि आप वास्तव में कॉपी / पेस्ट करने की आवश्यकता है है। मेरे उदाहरण में मैं साथ चला गया Worksheetसूचकांक के साथ 1और मैं मान लिया है एक सरल Valueस्थानांतरण क्या आप वास्तव में चाहते हो सकता है।

लेकिन इन पिछले दो चीजें आप पर विचार करने के लिए कर रहे हैं।

14/01/2020 को 00:23
का स्रोत उपयोगकर्ता

वोट
1

वैकल्पिक पद्धति का उपयोग करके Likeस्रोत / गंतव्य कार्यपुस्तिका के लिए परीक्षण करने के लिए ऑपरेटर। इसके अलावा स्रोत / गंतव्य पर्वतमाला कि डिबगिंग और बाद में अद्यतन करने में आसानी के लिए के माध्यम से लूप में चलाया जा सकता है परिभाषित करने के लिए एक तरह से प्रदान करता है। कोड भारी स्पष्टता के लिए टिप्पणी की।

Sub tgr()

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet

    'Check if exactly 2 workbooks are currently open
    If Application.Workbooks.Count <> 2 Then
        MsgBox "ERROR - There are [" & Application.Workbooks.Count & "] workbooks open." & Chr(10) & _
               "There must be two workbooks open:" & Chr(10) & _
               "-The source workbook (old template)" & Chr(10) & _
               "-The destination workbook"
        Exit Sub
    End If

    For Each wb In Application.Workbooks
        If wb.Name Like "*#.xls?" Then
            'Workbook name ends in number(s), this is the source workbook that will be copied from
            'You'll need to specify which sheet you're working with, this example code assumes the activesheet of that workbook
            Set wsSource = wb.ActiveSheet
        Else
            'Workbook name does not end in number(s), this is the source workbook that will be pasted to
            'You'll need to specify which sheet you're working with, this example code assumes the activesheet of that workbook
            Set wsDest = wb.ActiveSheet
        End If
    Next wb

    'Check if both a source and destination were assigned
    If wsSource Is Nothing Then
        MsgBox "ERROR - Unable to find valid source workbook to copy data from"
        Exit Sub
    ElseIf wsDest Is Nothing Then
        MsgBox "ERROR - Unable to find valid destination workbook to paste data into"
        Exit Sub
    End If

    'The first dimension is for how many times you need to define source and dest ranges, the second dimension should always be 1 to 2
    Dim aFromTo(1 To 2, 1 To 2) As Range
    'Add source copy ranges here:                       'Add destination paste ranges here
    Set aFromTo(1, 1) = wsSource.Range("M7:R19"):       Set aFromTo(1, 2) = wsDest.Range("M7")
    Set aFromTo(2, 1) = wsSource.Range("S7:AT16"):      Set aFromTo(2, 2) = wsDest.Range("U7")
    'Set aFromTo(3, 1) = wsSource.Range("M21:R33"):      Set aFromTo(3, 2) = wsDest.Range("M21")    'Example of a third copy/paste range - Dim aFromTo(1 to 3, 1 to 2)
    'Set aFromTo(4, 1) = wsSource.Range("S21:AT30"):     Set aFromTo(4, 2) = wsDest.Range("U21")    'Example of a fourth copy/paste range - Dim aFromTo(1 to 4, 1 to 2)

    'This will loop through the array of specified FromTo ranges and will ensure that only values are brought over
    Dim i As Long
    For i = LBound(aFromTo, 1) To UBound(aFromTo, 1)
        aFromTo(i, 2).Resize(aFromTo(i, 1).Rows.Count, aFromTo(i, 1).Columns.Count).Value = aFromTo(i, 1).Value
    Next i

End Sub
14/01/2020 को 00:49
का स्रोत उपयोगकर्ता

Cookies help us deliver our services. By using our services, you agree to our use of cookies. Learn more