Markieren-Kopieren...

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ButtonInA Dim lstrDateiName As String, liZeile As Integer Application.ScreenUpdateing = False lstrDateiName = Dir("DeinVerzeichnis\*.xls") liZeile = 10 Do Until lstrDateiName = "" Workbooks.Open "DeinVerzeichnis\" & lstrDateiName Range("B10:G100").Copy Workbooks(1).Activate Range("B" & liZeile).Select ActiveSheet.Paste Application.CutCopyMode = False Workbooks(2).Close SaveChanges:=False liZeile = liZeile + 91 lstrDateiName = Dir Loop Application.ScreenUpdateing = True End Sub

Sub ButtonInA() Dim lstrDateiName As String, liZeile As Integer Application.ScreenUpdating = False IstrDateiName = Dir("C:\Aktivitäten\Gebietsleiter.xls") liZeile = 10 Do Until lstrDateiName = "" Workbooks.Open "C:\Aktivitäten\Mitarbeiter\" & lstrDateiName Range("B10:G100").Copy Workbooks(1).Activate Range("B" & liZeile).Select ActiveSheet.Paste Application.CutCopyMode = False Workbooks(2).Close SaveChanges:=False liZeile = liZeile + 91 lstrDateiName = Dir Loop Application.ScreenUpdating = True End Sub

Sub ButtonInA() Dim lstrDateiName As String, liZeile As Integer Application.ScreenUpdating = False lstrDateiName = Dir("C:\Aktivitäten\Mitarbeiter\*.xls") liZeile = 10 Do Until lstrDateiName = "" Workbooks.Open "C:\Aktivitäten\Mitarbeiter\" & lstrDateiName Range("B10:G100").Copy Workbooks(1).Activate Range("B" & liZeile).Select ActiveSheet.Paste Application.CutCopyMode = False Workbooks(2).Close SaveChanges:=False liZeile = liZeile + 91 lstrDateiName = Dir Loop Application.ScreenUpdating = True End Sub

Sub ButtonInA() Dim lstrDateiName As String, liZeile As Integer Application.ScreenUpdating = False lstrDateiName = Dir("C:\Aktivitäten\Mitarbeiter\*.xls") liZeile = 10 Do Until lstrDateiName = "" Workbooks.Open "C:\Aktivitäten\Mitarbeiter\" & lstrDateiName Range("B10:G100").Copy Workbooks(1).Activate Range("B" & liZeile).Select ActiveSheet.Paste Application.CutCopyMode = False Workbooks(2).Close SaveChanges:=False 'liZeile = liZeile + 91 liZeile = 1 Do Until Workbooks(1).Range("B" & liZeile).Value = "" liZeile = liZeile + 1 Loop liZeile = liZeile + 1 lstrDateiName = Dir Loop Application.ScreenUpdating = True End Sub

Sub ButtonInA() Dim lstrDateiName As String, liZeile As Integer Application.ScreenUpdating = False lstrDateiName = Dir("C:\Aktivitäten\Mitarbeiter\*.xls") liZeile = 10 Do Until lstrDateiName = "" Workbooks.Open "C:\Aktivitäten\Mitarbeiter\" & lstrDateiName Range("B10:G100").Copy Workbooks(1).Activate Range("B" & liZeile).Select ActiveSheet.Paste Application.CutCopyMode = False Workbooks(2).Close SaveChanges:=False liZeile = 1 Do Until Workbooks(1).Sheets(1).Range("B" & liZeile).Value = "" liZeile = liZeile + 1 Loop liZeile = liZeile + 1 lstrDateiName = Dir Loop Application.ScreenUpdating = True End Sub

Hi Roland
Versuch es mal hiermit:

Sub ButtonInA()
Dim lstrDateiName As String, liZeile As Integer
Application.ScreenUpdating = False
lstrDateiName = Dir("C:\Aktivitäten\Mitarbeiter\*.xls")
Do Until lstrDateiName = ""
   Workbooks.Open "C:\Aktivitäten\Mitarbeiter\" & lstrDateiName

   liZeile = 1
        Do Until Sheets(1).Range("B" & liZeile).Value = ""
            liZeile = liZeile + 1
        Loop

   Range("B2:G" & liZeile).Copy
   Workbooks(1).Activate

        If Range("B2").Value = "" Then
                Range("B2").Select
        End If

   ActiveSheet.Paste
   Application.CutCopyMode = False
   Workbooks(2).Close SaveChanges:=False

liZeile = 1
Do Until Workbooks(1).Sheets(1).Range("B" & liZeile).Value = ""
liZeile = liZeile + 1
Loop
   Range("B" & liZeile).Select

   lstrDateiName = Dir
   Loop
Application.ScreenUpdating = True
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Vorausgesetzt, dass in jeder Tabelle in Zeile 1 Überschriften stehen, wird nun auch in den B-Workbooks der Bereich ermittelt, in dem Werte vorhanden sind (außer Zeile 1, da, wie gesagt, Überschriften???)
Der Grund, warum in den großen Dateien nur 90 Zeilen übertragen wurden, ist der, da Du ja ganz am Anfang den Bereich B10:G100 vorgegeben hattest. Da können nicht 100 Zeilen erfasst werden.
Und wenn diese Änderungen auch nicht helfen, dann lad einfach mal alle Dateien als Bsp auf den Server, ok? :-)
Ciao
Thorsten

Sub ButtonInA() Dim lstrDateiName As String, liZeile As Integer Application.ScreenUpdating = False lstrDateiName = Dir("C:\Aktiv\Ma\*.xls") Range("F9:U1000").ClearContents Do Until lstrDateiName = "" Workbooks.Open "C:\Aktiv\Ma\" & lstrDateiName liZeile = 9 Do Until Sheets(1).Range("F" & liZeile).Value = "" liZeile = liZeile + 1 Loop Range("B10:U" & liZeile).Copy Workbooks(1).Activate If Range("F9").Value = "" Then Range("F9").Select End If ActiveSheet.Paste Application.CutCopyMode = False Workbooks(2).Close SaveChanges:=False liZeile = 9 Do Until Workbooks(1).Sheets(1).Range("F" & liZeile).Value = "" liZeile = liZeile + 1 Loop Range("F" & liZeile).Select lstrDateiName = Dir Loop Application.ScreenUpdating = True Range("P1") = Date & ", " & Time Range("E1").Select End Sub

Hi Roland
Habe Deine Bsp-Datei runtergeladen, und nach einigen Code-Veränderungen werden nun auch bei mir wieder die WBA-WBC-Werte aus C:\Aktiv\MA in die Tabelle mit dem Namen "Daten" korrekt eingefügt.
Was ich nicht versethe, ist dieser VBA-Block aus DEINEM Code:


liZeile = 9
Do Until Sheets(1).Range("F" & liZeile).Value = ""
liZeile = liZeile + 1
Loop
Range("B10:U" & liZeile).Copy

Warum liZeile = 9, wenn in der Range-Zeile erst ab Zeile 10 markiert wird??
Oder hast Du nur vergessen, auch in Range den Bereich von B10:U in B9:U zu ändern?
Ich musste jedenfalls in jeder WB(a/b/c)-Tabelle in die Zelle F9 einen Wert eintragen, da ich Deinen Code an oben beschriebener Stelle nicht geändert hatte.
Also...
...entweder musst Du die Zeile


liZeile = 9


liZeile = 10

ändern
...oder Du musst a) die Zeile


Range("B10:U" & liZeile).Copy


Range("B9:U" & liZeile).Copy

ändern,
und b) in jeder WB(a/b/c)-Tabelle mindestens in Zelle F9 einen Wert hinzufügen.
2. Code-Änderung:
die Zeile


Do Until Workbooks(1).Sheets(1).Range("F" & liZeile).Value = ""

funktioniert so nur, wenn auch das Tabellenblatt, in das die Werte eingefügt werden sollen, an erster Stelle steht -->Sheets(1)
Da aber in Deiner neuen Bsp-Datei das entsprechende Blatt NICHT an erster Stelle steht, werden die Daten in das Blatt "Übersicht VG" eingefügt. Das "richtige" Tabellenblatt befindet sich hier erst an der dritten Stelle.
Da ich nicht weiß, ob auch in der Echtdaten-Datei das "gesuchte" Tabellenblatt an der dritten Stelle steht, aber davon ausgehe, dass der Blattname identisch ist, habe ich die Befehlszeile SO geändert:


Do Until Workbooks(1).Sheets("Daten").Range("F" & liZeile).Value = ""

Auch das "Problem" mit dem Wunsch "nur Werte, aber nicht Formeln und/oder Formate einzufügen" ist gelöst.
Und hier ist die von mir korrigierte Version:
https://www.herber.de/bbs/user/6444.xls
Bin ja nun neugierig, was als nächstes kommt :)
Ciao
Thorsten

Beliebteste Forumthreads (12 Monate)

23 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

23
Beiträge zum Forumthread

Beiträge zu diesem Forumthread