kombinieren Sie zwei Bereiche (einzelne Zelle und Bereich) von mehreren Arbeitsmappen zu Arbeitsblatt

Question

Ich habe hier einige Skript, um mehrere Arbeitsmappen mit einem Arbeitsblatt zu öffnen und kopieren Sie es dann als Schleife in ein Arbeitsblatt, aber ich brauche eine zusätzliche Zelle (das Datum) aus einem anderen Arbeitsblatt in den mehreren Arbeitsmappen, da die Ausgabe, die ich erhalten habe, nicht geändert werden kann und nur zu demselben Blatt hinzugefügt werden kann.

Was ich brauche, ist, dass dieser Code einen einzelnen Zellbereich von einem anderen Blatt in der Arbeitsmappe enthält und dann bis zum Ende des Bereichs pro Arbeitsmappe füllt.

Ich kann UNION nicht verwenden, da es nicht die gleiche Länge ist, und ich schaute Bereiche in eins zusammen, aber ich bekomme Typ Mismatch-Fehler.

VBA: How to combine two ranges on different sheets into one, to loop through Ich habe das versucht, aber ich kann nicht herausfinden, wie man es in meinen Code einfügt.

Hier ist der Code, den ich bisher nur für den einen Bereich funktioniert. Die rngdate kopiert über, aber hinterlässt keine Lücke oder Autofill für die nächste Schleife, es fügt nur untereinander, also vielleicht funktioniert dieser Code, aber ich vermisse etwas Grundlegendes wie AutoFill?

Dim vFileNames As Variant 
Dim y As Long 
Dim wbTemp As Workbook 
Dim wbNew As Workbook 
Dim blHeader As Boolean 
Dim Rng As Range 
Dim rngDate As Range 

Application.ScreenUpdating = False 
Set wbNew = Workbooks("master_timesheet") '.Add 
blHeader = False 
vFileNames = Application.GetOpenFilename(Title:="Select all workbooks to copy", _ 
MultiSelect:=True) 
'Will not be array if no file is selected 
'If user selects one or more files, files will be stored as an array 
If Not IsArray(vFileNames) Then GoTo ConsolidateWB_End 
For y = LBound(vFileNames) To UBound(vFileNames) 
    'Open each wb selected 
    Set wbTemp = Workbooks.Open(vFileNames(y)) 
    Set rngDate = wbTemp.Worksheets("Communications Unlimited Inc").Range("A5").CurrentRegion 
    Set Rng = wbTemp.Worksheets("Export").Range("A1").CurrentRegion 


    'If header row already copied, then offset by 1 to exclude header 
    If blHeader Then 
     Set Rng = Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1) 
     'If header row not already copied, keep rng as is and change blHeader to true 
    Else 
     blHeader = True 
    End If 
    'Paste to next row on new wb 

    Rng.Copy Destination:=wbNew.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0) 
    rngDate.Copy Destination:=wbNew.Sheets(1).Range("P65536").End(xlUp).Offset(1, 0) 

    wbTemp.Close SaveChanges:=False 
Next y 
    ConsolidateWB_End: 
     Application.ScreenUpdating = True 
End Sub 

Answer 1

Wenn ich Ihr Problem richtig lesen möchten Sie das Datum, rngdate, zu jedem klebte benachbarte und jede Zeile von Daten, die Sie gerade kopiert haben. Ihr aktueller Code setzt die Daten jedoch nur in die erste Zeile. Unten ist eine Anpassung, wie ich dieses Problem selbst gelöst habe, unter Berücksichtigung Ihres bestehenden Codes. (Meine Vermutung ist, dass es eine viel elegantere Lösung als diese, die ich bin einfach nicht bewusst.)

Dim pasterangefirstrow As Integer 

...

pasterangefirstrow = wbNew.Sheets(1).Range("D65536").End(xlUp).Offset(1, 0).Row 

...

With wbNewSheets(1) 
    Rng.Copy Destination:=.Range("D65536").End(xlUp).Offset(1, 0) 
    rngdate.Copy Destination:=.Range("P" & pasterangefirstrow & ":P" & pasterangefirstrow + Rng.Rows.Count - 1) 
End With