किसी अन्य कार्यपुस्तिका (एक्सेल) से डेटा कॉपी करने के लिए कैसे?

Question

मेरे पास पहले से एक मैक्रो है जो चादरें और कुछ अन्य सामान बनाता है। एक शीट बनाने के बाद क्या मैं एक और मैक्रो कॉल करना चाहता हूं जो डेटा को दूसरी एक्सेल (इसकी खुली) से पहली और सक्रिय एक्सेल फ़ाइल में कॉपी करता है।

सबसे पहले मैं हेडर पर प्रतिलिपि बनाना चाहता हूं, लेकिन मैं इसे काम नहीं कर सकता - त्रुटियां प्राप्त करना जारी रखें।

Sub CopyData(sheetName as String) 
    Dim File as String, SheetData as String 

    File = "my file.xls" 
    SheetData = "name of sheet where data is" 

    # Copy headers to sheetName in main file 
    Workbooks(File).Worksheets(SheetData).Range("A1").Select # fails here: Method Select for class Range failed 
    Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select 
    Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1) 
End Sub 

क्या गलत है?

मैं वास्तव में "मेरी file.xls" सक्रिय करने से बचना चाहता हूं।

संपादित करें: मुझे इसे देना था और इसे काम करने से पहले, एक नई शीट के रूप में फ़ाइल को लक्षित करने के लिए शीटडाटा की प्रतिलिपि बनाना था। Find and select multiple rows

Answer 1

क्या आपको स्क्रीन पर कोई प्रभाव नहीं पड़ने पर "मेरी file.xls" सक्रिय करने में खुशी होगी? स्क्रीन अपडेटिंग को बंद करना यह हासिल करने का तरीका है, इसमें प्रदर्शन सुधार भी हैं (महत्वपूर्ण है यदि आप कार्यपत्रकों/कार्यपुस्तिकाओं के चारों ओर स्विच करते समय लूपिंग कर रहे हैं)।

आदेश यह करने के लिए है:

Application.ScreenUpdating = False 

मत भूलना जब अपने मैक्रो समाप्त हो गया है यह True को पुन: चालू करने।

Answer 2

मुझे नहीं लगता कि आपको कुछ भी चुनने की ज़रूरत है। मैंने बुक 1 और बुक 2 में दो खाली कार्यपुस्तिकाएं खोलीं, बुक 2 में शीट 1 के रेंज ("ए 1") में मूल्य "ए" डाला, और निम्नलिखित कोड को तत्काल विंडो में सबमिट किया -

कार्यपुस्तिकाएं (2)। वर्कशीट्स (1) रेंज ("ए 1")। वर्कबुक कॉपी करें (1)। वर्कशीट्स (1) .ेंज ("ए 1")

बुक 1 के शीट 1 में रेंज ("ए 1") में अब "ए" शामिल है।

इसके अलावा, इस तथ्य को देखते हुए कि आप अपने कोड में ActiveWorkbook से "myfile.xls" पर प्रतिलिपि बनाने का प्रयास कर रहे हैं, ऑर्डर को उलट दिया जाता है क्योंकि कॉपी विधि को ActiveWorkbook में किसी श्रेणी पर लागू किया जाना चाहिए, और गंतव्य (कॉपी फ़ंक्शन के लिए तर्क) "myfile.xls" में उचित सीमा होनी चाहिए।

Answer 3

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

Workbooks(File).Worksheets(SheetData).Range("A1").Select
Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select
Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

Workbooks(File).Worksheets(SheetData).Range(Workbooks(File).Worksheets(SheetData). _
Range("A1"), Workbooks(File).Worksheets(SheetData).Range("A1").End(xlToRight)).Copy _
Destination:=ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

इस के साथ प्रतिस्थापित किया जा सकता है का चयन त्रुटि चारों ओर मिलना चाहिए।

Answer 4

सर्वोत्तम अभ्यास स्रोत फ़ाइल खोलना है (यदि आप परेशान नहीं होना चाहते हैं तो झूठी दृश्य स्थिति के साथ) और फिर हम इसे बंद कर दें।

एक काम करने और स्वच्छ कोड नीचे दिए गए लिंक पर avalaible है:

http://vba-useful.blogspot.fr/2013/12/how-do-i-retrieve-data-from-another.html

Answer 5

मैं एक का उपयोग कर VBA के लिए एक कार्यपुस्तिका से डेटा की प्रतिलिपि की जरुरत थी। आवश्यकता 1 के नीचे उल्लिखित थी।एक सक्रिय एक्स बटन दबाकर उस फ़ाइल का चयन करने के लिए संवाद खोलें जिससे डेटा कॉपी करने की आवश्यकता है। 2. ठीक क्लिक करने पर मूल्य को सेल/रेंज से वर्तमान में कार्यरत कार्यपुस्तिका में कॉपी किया जाना चाहिए।

मैं खुले समारोह का उपयोग करने के क्योंकि यह कार्यपुस्तिका जो कष्टप्रद

नीचे हो जाएगा खुलता नहीं करना चाहता था कोड है कि मैं VBA में लिखा है। कोई भी सुधार या नया विकल्प स्वागत है।

कोड: सी 4 A1 किसी कार्यपुस्तिका से सामग्री: यहाँ मैं A1 को कॉपी कर रहा हूँ वर्तमान कार्यपुस्तिका के सी 4

Private Sub CommandButton1_Click() 
     Dim BackUp As String 
     Dim cellCollection As New Collection 
     Dim strSourceSheetName As String 
     Dim strDestinationSheetName As String 
     strSourceSheetName = "Sheet1" 'Mention the Source Sheet Name of Source Workbook 
     strDestinationSheetName = "Sheet2" 'Mention the Destination Sheet Name of Destination Workbook 


     Set cellCollection = GetCellsFromRange("A1:C4") 'Mention the Range you want to copy data from Source Workbook 

     With Application.FileDialog(msoFileDialogOpen) 
      .AllowMultiSelect = False 
      .Show 
      '.Filters.Add "Macro Enabled Xl", "*.xlsm;", 1 

      For intWorkBookCount = 1 To .SelectedItems.Count 
       Dim strWorkBookName As String 
       strWorkBookName = .SelectedItems(intWorkBookCount) 
       For cellCount = 1 To cellCollection.Count 
        On Error GoTo ErrorHandler 
        BackUp = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) 
        Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = GetData(strWorkBookName, strSourceSheetName, cellCollection.Item(cellCount)) 
        Dim strTempValue As String 
        strTempValue = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)).Value 
        If (strTempValue = "0") Then 
         strTempValue = BackUp 
        End If 
Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = strTempValue 
ErrorHandler: 
        If (Err.Number <> 0) Then 
          Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = BackUp 
         Exit For 
        End If 
       Next cellCount 
      Next intWorkBookCount 
     End With 

    End Sub 

    Function GetCellsFromRange(RangeInScope As String) As Collection 
     Dim startCell As String 
     Dim endCell As String 
     Dim intStartColumn As Integer 
     Dim intEndColumn As Integer 
     Dim intStartRow As Integer 
     Dim intEndRow As Integer 
     Dim coll As New Collection 

     startCell = Left(RangeInScope, InStr(RangeInScope, ":") - 1) 
     endCell = Right(RangeInScope, Len(RangeInScope) - InStr(RangeInScope, ":")) 
     intStartColumn = Range(startCell).Column 
     intEndColumn = Range(endCell).Column 
     intStartRow = Range(startCell).Row 
     intEndRow = Range(endCell).Row 

     For lngColumnCount = intStartColumn To intEndColumn 
      For lngRowCount = intStartRow To intEndRow 
       coll.Add (Cells(lngRowCount, lngColumnCount).Address(RowAbsolute:=False, ColumnAbsolute:=False)) 
      Next lngRowCount 
     Next lngColumnCount 

     Set GetCellsFromRange = coll 
    End Function 

    Function GetData(FileFullPath As String, SheetName As String, CellInScope As String) As String 
     Dim Path As String 
     Dim FileName As String 
     Dim strFinalValue As String 
     Dim doesSheetExist As Boolean 

     Path = FileFullPath 
     Path = StrReverse(Path) 
     FileName = StrReverse(Left(Path, InStr(Path, "\") - 1)) 
     Path = StrReverse(Right(Path, Len(Path) - InStr(Path, "\") + 1)) 

     strFinalValue = "='" & Path & "[" & FileName & "]" & SheetName & "'!" & CellInScope 
     GetData = strFinalValue 
    End Function