Gegevens verschilledende bestand onder elkaar zetten

[Taribo1982]

Beste forum gebruikers,

Ik heb het volgende probleem:

Ik heb een 9 identieke Excel bestanden. Nu wil ik hiervan een totaal bestand maken. Dus alle regels van tabblad G van de bestanden 1 t/m 9 onder elkaar in het totaal bestand in tabblad G beginenned vanaf rij 8. Dit zou ik dan willen voor elk tabblad.

Nu heb ik al een tijd lang zitten zoeken op dit forum maar ik kom er niet uit. Ik heb al de volgende code in het bestand staan(zie hieronder). Deze code plakt de gegevens uit bestand naar het totaal bestand beginnend op rij 8. Nu wil ik dat de rijen vanuit bestand 2 in het totaal bestand onder de reeds gekopieerde rijen worden geplakt. Weet iemand hoe dit moet? Alvast vriendelijk bedankt!!!

Groeten,

Taribo

Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

' Selecteer in de specificatie 612 het zelfde tabblad

Windows("612 PA Specificaties JR 2008.xls").Activate
Sheets("G-1051000").Select

'Start met zoeken in rij 8
LSearchRow = 8

'Kopieer de gegevens naar naar PA brede specificatie beginnend bij rij 8 (row counter variable)
LCopyToRow = 8

While Len(Range("D" & CStr(LSearchRow)).Value) > 0

'Wanneer de waarde in kolom D > 0, kopieer de gehele rij naar de PA brede specificatie
If Range("D" & CStr(LSearchRow)).Value > 0 Then

'Selecteerde rij in de OE specificatie om te kopiëren
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Plak de rij in de PA brede specificatie in de volgende rij
Windows("PA Specificaties Jaarrekening 2008.xls").Activate
Sheets("G-1051000").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Zet de cursor naar de volgende rij
LCopyToRow = LCopyToRow + 1

'Ga terug naar de OE leadsheet en begin opnieuw met zoeken
Windows("612 PA Specificaties JR 2008.xls").Activate

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell C8
Application.CutCopyMode = False
Range("C8").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

 

[gast0667]

In je excel-bestand zie ik geen VBA code. Dus kon niet kijken wat je precies bedoelt.
Ik weet ook niet wat je allemaal invult in de 9 bestanden / bladen en hoe het uiteindelijke er uit moet zien.

Maar zo op het oog zou ik het volgende zeggen:

Nadat je de eerste excelblad hebt gekopieerd naar de hoofdblad. Moet je in het hoofdblad gewoon zoeken naar een lege rij, zoiets als:

With worksheets("Hoofdblad").range("A:A")
Set a = .find("", lookat:=xlwhole, lookin:=xlvalues)
If not a is nothing then
vLegeRij = a.row
end if
end with

En deze code loop je gewoon door met je huidige code voor elk blad. Er is met deze code wel een maaaar, namelijk dat als je iets kopieerd vanuit 1 blad waar tussen enkele gegevens rijen een lege rij is dat de code dan die lege rij oppakt en niet de laatste.

suc6

 

[snb]

Stel 9 werkboeken
Met ieder 10 werkbladen (met de naam A t/m J)
Dan zet ik alle gegevens van werkboek 1 t/m 8 in het corresponderende werkblad van werkboek 9 met

Sub totaliseer()
   for j= 1 to 8
     for jj=65 to 75
       with workbooks(9).sheets(chr(jj))
         workbooks(j).sheets(chr(jj)).usedrange.copy .cells(.usedrange.row+1,1)
       end with
     next
  next
End Sub