Új hozzászólás Aktív témák

• #36208 Pakliman tag ben800 #36204

  Új Válasz 2017-09-28 13:56:07 #36208

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Pakliman

  tag

  válasz ben800 #36204 üzenetére

  Úgy nagyjából valami ilyesmi...

  Public Sub AdatMásolás()
Dim wbT As Workbook 'A "kis" munkafüzet, ami tartalmazza a...
Dim wsT As Worksheet '..munkalapokat (1-től 12-ig)
Dim cT As Long 'Számláló (a 19 db táblázathoz)
Dim usT As Long 'A kis táblázat utolsó sora

Dim aws As Worksheet 'Csak azért, hogy ne ActiveSheet legyen:)
Dim us As Long 'A FŐ táblázat utolsó sora

Dim sor As Long 'Egyszerű számláló
Dim talált 'A keresett azonosító cellacíme lesz

Set aws = ActiveSheet

For cT = 1 To 19
On Error GoTo Hiba
Set wbT = Workbooks.Open("a feldolgozandó kis táblázat neve útvonallal együtt")
For Each wsT In wbT.Worksheets
usT = wsT.Cells(wsT.Rows.Count, 1).End(xlUp).Row
For sor = 2 To usT 'Feltételezve, hogy az 1. sor fejléc
'Az azonosító az 1. oszlopban van
'!!! A FŐ táblában (aws) keressük a kis táblás azonosítót (wsT.Cells(sor, 1)) !!!
Set talált = aws.Columns(1).Find(What:=wsT.Cells(sor, 1), LookAt:=xlWhole, MatchCase:=True)
'Ha találtunk, akkor nem csinálunk semmit.
'Ellenben:
If talált Is Nothing Then
us = aws.Cells(aws.Rows.Count, 1).End(xlUp).Row
aws.Cells(us + 1, 1) = "azonosító"
aws.Cells(us + 1, 2) = "adat1"
aws.Cells(us + 1, 3) = "adat2"
aws.Cells(us + 1, 4) = "adat3"
aws.Cells(us + 1, 5) = "adat4"
aws.Cells(us + 1, 6) = "adat5"
'...

End If

Next sor
Next wsT

On Error GoTo 0
wbT.Close SaveChanges:=False
Next cT

Set wbT = Nothing
Set wsT = Nothing
Set aws = Nothing
GoTo Vége

Hiba:
'Hibakezelés, pl. ha nincs olyan fájl stb.
'Ha nem kell tenni semmit hiány esetén, akkor egyszerűen csak..
Resume Next

Vége:

End Sub

Új hozzászólás Aktív témák