कोशिकाओं की एक श्रृंखला की प्रतिलिपि बनाएँ और डेटा

Question

के साथ केवल कक्षों का चयन करें, मैं कक्षों की एक श्रृंखला की प्रतिलिपि बनाने का एक तरीका ढूंढ रहा हूं, लेकिन केवल उन कक्षों की प्रतिलिपि बनाने के लिए जो मूल्य रखते हैं।

मेरी एक्सेल शीट में मेरे पास ए 1-ए 18 से चलने वाला डेटा है, बी खाली है और सी 1-सी 2 है। अब मैं उन सभी कक्षों की प्रतिलिपि बनाना चाहता हूं जिनमें मूल्य शामिल है।

With Range("A1") 
    Range(.Cells(1, 1), .End(xlDown).Cells(50, 3)).Copy 
End With 

यह A1-C50 से सब कुछ नकल होगा, लेकिन मैं केवल A1-A18 और सी 1-सी 2 के रूप में यद्यपि इन डेटा होते देखा कॉपी किया जा करना चाहते हैं। लेकिन इसे इस तरह से गठित करने की जरूरत है कि एक बार जब मेरे पास बी या मेरी सीमा में डेटा हो, तो ये भी कॉपी हो जाएंगे।

'So the range could be 5000 and it only selects the data with a value. 
With Range("A1") 
Range(.Cells(1, 1), .End(xlDown).Cells(5000, 3)).Copy 
End With 

धन्यवाद!

---

जीन, वर्तमान कोड के लिए धन्यवाद:

Sub test() 

Dim i As Integer 
Sheets("Sheet1").Select 
i = 1 

With Range("A1") 
    If .Cells(1, 1).Value = "" Then 
    Else 
    Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("A" & i) 
    x = x + 1 
    End If 
End With 

Sheets("Sheet1").Select 

x = 1 
With Range("B1") 
' Column B may be empty. If so, xlDown will return cell C65536 
' and whole empty column will be copied... prevent this. 
    If .Cells(1, 1).Value = "" Then 
     'Nothing in this column. 
     'Do nothing. 
    Else 
     Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("B" & i) 
     x = x + 1 
    End If 
End With 

Sheets("Sheet1").Select 

x = 1 
With Range("C1") 
    If .Cells(1, 1).Value = "" Then 
    Else 
     Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("C" & i) 
     x = x + 1 
    End If 
End With 

End Sub 

A1 - ए 5 डेटा होता है, ए 6 ब्लॉन्क है, ए 7 डेटा होता है। यह ए 6 पर रुक जाता है और कॉलम बी पर जाता है, और उसी तरह जारी रहता है।

Answer 1

चूंकि आपके तीन कॉलम के अलग-अलग आकार हैं, इसलिए सबसे सुरक्षित बात यह है कि उन्हें एक-एक करके कॉपी करना है। कोई भी शॉर्टकट्स à la PasteSpecial शायद आपको सिरदर्द का कारण बन जाएगा।

With Range("A1") 
    Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeA 
End With 

With Range("B1") 
    ' Column B may be empty. If so, xlDown will return cell C65536 
    ' and whole empty column will be copied... prevent this. 
    If .Cells(1, 1).Value = "" Then 
     'Nothing in this column. 
     'Do nothing. 
    Else 
     Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeB 
    EndIf 
End With 

With Range("C1") 
    Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeC 
End With 

अब इस बदसूरत है, और एक क्लीनर विकल्प कॉलम लूप करने के लिए हो सकता है, खासकर यदि आप कई कॉलम है और आप उसी क्रम में सन्निकट स्तंभ के लिए उन्हें पेस्ट करते।

Sub CopyStuff() 

    Dim iCol As Long 

    ' Loop through columns 
    For iCol = 1 To 3 ' or however many columns you have 
     With Worksheets("Sheet1").Columns(iCol) 
      ' Check that column is not empty. 
      If .Cells(1, 1).Value = "" Then 
       'Nothing in this column. 
       'Do nothing. 
      Else 
       ' Copy the column to the destination 
       Range(.Cells(1, 1), .End(xlDown)).Copy _ 
        Destination:=Worksheets("Sheet2").Columns(iCol).Cells(1, 1) 
      End If 
     End With 
    Next iCol 

End Sub 

---

संपादित तो आप अपने प्रश्न बदल दिया है ... व्यक्तिगत कोशिकाओं के माध्यम से पाशन की कोशिश करें, पता चल सके कि वर्तमान कक्ष खाली है, और इसकी नकल नहीं करता है, तो। इस परीक्षण नहीं किया है, लेकिन आप अंदाजा हो:

iMaxRow = 5000 ' or whatever the max is. 
    'Don't make too large because this will slow down your code. 

    ' Loop through columns and rows 
    For iCol = 1 To 3 ' or however many columns you have 
     For iRow = 1 To iMaxRow 

     With Worksheets("Sheet1").Cells(iRow,iCol) 
      ' Check that cell is not empty. 
      If .Value = "" Then 
       'Nothing in this cell. 
       'Do nothing. 
      Else 
       ' Copy the cell to the destination 
       .Copy Destination:=Worksheets("Sheet2").cells(iRow,iCol) 
      End If 
     End With 

     Next iRow 
    Next iCol 

इस कोड को वास्तव में अगर iMaxRow बड़ी है धीमी गति से किया जाएगा। मेरा झुकाव यह है कि आप एक तरह से अक्षम तरीके से किसी समस्या को हल करने की कोशिश कर रहे हैं ... जब सवाल बदलता रहता है तो इष्टतम रणनीति पर बसना मुश्किल होता है।

Answer 2

पेस्ट विशेष फ़ंक्शन पर एक नज़र डालें। एक 'खाली खाली' संपत्ति है जो आपकी मदद कर सकती है।

Answer 3

जीन-फ्रैंकोइस कॉर्बेट के उत्तर पर सुधार करने के लिए, उपयोग करें .UsedRange.Rows. अंतिम उपयोग पंक्ति प्राप्त करने के लिए गणना करें। यह आपको काफी सटीक सीमा देगा और यह पहले खाली सेल पर नहीं रुक जाएगा।

यहाँ शुरुआती के लिए टिप्पणी की नोटों के साथ एक उत्कृष्ट उदाहरण के लिए एक लिंक है ...

• Excel macro - paste only non empty cells from one sheet to another - Stack Overflow