पहली बार यहाँ पूछने वाला। मुझे एक ही विशिष्ट कक्षों को एकाधिक कार्यपत्रकों से एक मास्टरशीट में कॉपी करने के लिए एक अच्छा वीबीए कोड मिला और वास्तव में अपना काम करता है (मुझे याद नहीं है कि मैं इसे मूल रूप से कहां से देखता हूं)। एकमात्र छोटा मुद्दा यह है कि यह सेल ए 2 से डेटा इनपुट करना शुरू कर देता है, जबकि मैं इसे सेल ए 4 से शुरू करना चाहता हूं।

यहाँ कोड है:

Sub ListFB()
Sheets("Master").Range("A4").Value = "Sheet Name"
For I = 1 To ThisWorkbook.Worksheets.Count
If Sheets(I).Name <> "RiassuntoTEST" Then
    Sheets("Master").Cells(I, 1).Value = Sheets(I).Range("B2").Value
   Sheets("Master").Cells(I, 2).Value = Sheets(I).Range("C2").Value
   Sheets("Master").Cells(I, 3).Value = Sheets(I).Range("C10").Value
   Sheets("Master").Cells(I, 4).Value = Sheets(I).Range("C11").Value
   Sheets("Master").Cells(I, 5).Value = Sheets(I).Range("C15").Value
   Sheets("Master").Cells(I, 6).Value = Sheets(I).Range("C16").Value
   Sheets("Master").Cells(I, 7).Value = Sheets(I).Range("C20").Value
   Sheets("Master").Cells(I, 8).Value = Sheets(I).Range("C21").Value
   Sheets("Master").Cells(I, 9).Value = Sheets(I).Range("C25").Value
   Sheets("Master").Cells(I, 10).Value = Sheets(I).Range("C26").Value
   Sheets("Master").Cells(I, 11).Value = Sheets(I).Range("C29").Value
   Sheets("Master").Cells(I, 12).Value = Sheets(I).Range("C30").Value
   Sheets("Master").Cells(I, 13).Value = Sheets(I).Range("C33").Value
   Sheets("Master").Cells(I, 14).Value = Sheets(I).Range("C34").Value
    End If
Next I
End Sub

मुझे लगता है कि यह शीट I से मूल्य बी 2 लेता है और इसे मास्टरशीट के ए 2 में कॉपी करता है, फिर सी 2 लेता है और इसे बी 2 में कॉपी करता है, जब तक कि उस शीट से सभी आवश्यक डेटा समान पंक्तियों में न हो, फिर अगले पर जाता है शीट और डेटा को अगली पंक्तियों में रखता है। जैसा कि मैंने ऊपर कहा, मैं चाहूंगा कि यह पूरी प्रक्रिया A2 के बजाय A4 से शुरू हो।

मैं इस तरह के सामान के लिए बिल्कुल नया हूं इसलिए किसी भी इनपुट और मदद की सराहना की जाती है। इसके अलावा, पंक्ति करता है

Sheets("Master").Range("A4").Value = "Sheet Name"

मेरे उद्देश्य के लिए कुछ भी करो?

शुक्रिया!

-1
TheToz 23 जिंदा 2020, 13:00

2 जवाब

सबसे बढ़िया उत्तर

पहला मुद्दा:

Sheets("RiassuntoTEST").Cells(I, 1).Value

Cells वह रखता है जिसे R1C1 संदर्भ के रूप में जाना जाता है। अर्थ पंक्ति संख्या, स्तंभ संख्या। चूँकि यह पंक्ति I = 1 To ThisWorkbook.Worksheets.Count आपके पास मौजूद कार्यपत्रकों की संख्या तक 1 से गिना जाता है, यह पंक्ति 1, कॉलम 1 में चिपकाना शुरू हो जाएगा, जिसे सेल A1 के रूप में भी जाना जाता है। यदि आप इसके बजाय सेल A4 में इसे बढ़ाना चाहते हैं, तो आपको इसे इस तरह 3 से बढ़ाना होगा:

Sheets("RiassuntoTEST").Cells(I + 3, 1).Value

ऐसा आपको हर लाइन पर करना होगा।

दूसरा मुद्दा:

इसके अलावा, क्या पंक्ति पत्रक("RiassuntoTEST").Range("A4").Value = "Nome Foglio" मेरे उद्देश्य के लिए कुछ भी करते हैं?

नहीं, ऐसा नहीं है, जैसा कि पहले कहा गया है, आपका कोड (अब) सेल A4 पर चिपकाना शुरू कर देगा, इसलिए जैसे ही दूसरा ब्लॉक चलना शुरू होता है, इसे अधिलेखित कर दिया जाता है।

1
Plutian 23 जिंदा 2020, 13:10

मैं आपके कोड को इस तरह से फिर से लिखता हूं ताकि आप अपने इच्छित सभी संशोधन कर सकें - शायद कोड की पंक्तियों के बीच मेरे द्वारा डाली गई टिप्पणियों की थोड़ी मदद से।

Option Explicit

Sub UpdateMaster()
    ' Variatus @STO 23 Jan 2020

    Dim Wb As Workbook
    Dim MasterWs As Worksheet
    Dim Ws As Worksheet
    Dim SourceCell() As String
    Dim Rt As Long                          ' target row
    Dim Ct As Long                          ' target column
    Dim i As Integer

    Set Wb = ThisWorkbook                   ' you might specify another workbook
    ' specify the Master worksheet here
    Set MasterWs = Wb.Worksheets("TEST")
    ' list all the source cells here
    SourceCell = Split("B2,C2,C10,C11,C15,C16,C20,C21,C25,C26,C29,C30,C33,C34", ",")
    Rt = 4                                  ' set first row to write to here

    With MasterWs
        ' keep contents in rows 1 to 3 (incl title)
        .Range(.Cells(Rt, 1), .Cells(.Rows.Count, "A").End(xlUp) _
                                     .Offset(0, UBound(SourceCell) + 1)) _
                                     .ClearContents
    End With

    Application.ScreenUpdating = False      ' speeds up execution
    For i = 1 To Wb.Worksheets.Count
        Set Ws = Wb.Worksheets(i)
        If Not Ws Is MasterWs Then
            For Ct = 0 To UBound(SourceCell)
                MasterWs.Cells(Rt + i - 1, Ct + 1) = Ws.Range(Trim(SourceCell(Ct))).Value
            Next Ct
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
0
Variatus 23 जिंदा 2020, 13:49