Excel Stapelverarbeitung

Computer: Software & Programmierung Visual Basic
#1

Ich versuche aus ca. 2000 in Excel geschriebenen Rechungen die Adressen raus zu kopieren.

Ich habe mir folgendes Script zusammen geschrieben. Das Script funktioniert schon ganz gut. Es habe ich aber noch ein Problem. Ich möchte mehrere Bereiche exportieren, aber mit dem Script kann ich immer nur einen Bereich wählen:

Range(„B8:B22“).Select
Selection.Copy

Ich hatte schon folgende Änderung gemacht, aber diese greift nicht:

Range(„B8:B22;E8:E12;F3:F12“).Select
Selection.Copy

Vielen Dank im Voraus.

##############################################
Sub Start()

Application.DisplayAlerts = False

Dim strMaster As String
Dim strPath As String
Dim strFile As String
Dim intA As Integer

strMaster = ActiveWorkbook.Name

'strPath ist das Verzeichnis in dem die einzelnen Dateien liegen
strPath = „C:\adressen“

Columns(„C:Q“).Select
Selection.ClearContents

For i = 1 To 2000

On Error Resume Next

intA = i
strFile = Range(„A“ & i).Value

Call Kopieren(strPath, strFile, intA, strMaster)

Next i

Application.DisplayAlerts = True

End Sub

Function Kopieren(strPath As String, strFile As String, intA As Integer, strMaster As String)

Workbooks.Open Filename:=strPath & strFile
Range(„B8:B22“).Select
Selection.Copy
Windows(strMaster).Activate
Range(„C“ & intA).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

=False, Transpose:=True

Windows(strFile).Activate
Application.CutCopyMode = False

ActiveWindow.Close

End Function
#########################################################

#2

Hallo toyoliker,

mit copy/paste zu arbeiten bietet sich bei deiner Problemstellung m.M. nach nicht an.
Mein Vorschlag wäre es, die Zieldateien als Objekt zu öffnen und die entsprechenden Bereiche nacheinander auszulesen.
Etwa so:
dim xlsApp as Excel.Application
dim xlsWkb as Excel.Workbook
set xlsWkb = xlsApp.open(„C:\adressen“ & strFile)
for i = 1 to 5
Thisworkbook.sheets(„AlleAdressen“).cells(i,1) = xlsWkb.Sheets(„Tabelle1“).cells(1,1)
… --mit allen Feldern ausführlich–
next i

damit umgehst du das Problem komplett…

VG Bugged

#3

Wenn ich das richtig verstanden haben sollte, brauchst Du in Deiner Function lediglich die Zeilen
Range(„B8:B22“).Select
Selection.Copy
Windows(strMaster).Activate
Range(„C“ & intA).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
=False, Transpose:=True

nur noch zweimal wiederholen, also z.B.

Range(„E8:E12“).Select
Selection.Copy
Windows(strMaster).Activate
Range(„G“ & intA).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
=False, Transpose:=True

Range(„F3:F12“).Select
Selection.Copy
Windows(strMaster).Activate
Range(„H“ & intA).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
=False, Transpose:=True

#4

Ich kann Dir bei diesem Problem leider nicht helfen.
Sorry.
VG Mike

#5

Hallo toyoliker,

Du kannst so viele Bereiche kopieren, wie nötig sind. Dazu änderst Du die Funktion Kopieren wie folgt:

Function Kopieren(strPath As String, strFile As String, intA As Integer, strMaster As String)

Workbooks.Open Filename:=strPath & strFile
Range(„B8:B22“).Select
Selection.Copy
=> jetzt ist das gewünschte kopiert
Windows(strMaster).Activate
=> weglassen (ohne Bildschirmdarstellung geht es schneller)
Workbooks(strMaster).Worksheets(hierdeintabellenname).cells(y, x).PasteSpecial / y, x sind die Zellkoordinaten (geht auch mit Range)

Rest weglassen
'Range(„C“ & intA).Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
'Windows(strFile).Activate
'Application.CutCopyMode = False
'ActiveWindow.Close

Und dafür die Aktionen von oben für anderen Bereich wiederholen; Also:

  • Workbooks(quelle).Worksheets(1) bzw. (name).Range.select
  • Copy
  • Workbooks(master).Worksheets(1) bzw. (name).Paste

usw.

Gruß
Harry

End Function
#########################################################

#6

Musst du so ändern
Range(„B8:B22,E8:E12,F3:F12“).Select

Bringt dir aber nix weil du die Zellen mit
Selection.Copy nicht kopieren kannst…

#7

Hallo!
Wenn ich mit der Funktion „Makro aufzeichen“ !!! mehrere Bereiche selektiere und sehe mir das anschließend an, dann sind die Bereiche durch Komma getrennt, nicht durch Semikolon!!!

Gruß
Wolfram

#8

Ok, trotzdem Danke

Ich kann Dir bei diesem Problem leider nicht helfen.
Sorry.
VG Mike

#9

Dieser Weg scheint nicht zu funktionieren. Da er irgendwie die Bereiche schreibt und dann wieder überschreibt.

#10

Stimmt

#11

Vielen Dank für die ganzen Ansätze. Ich habe mich am Ende dafür entschieden, dass ich für jeden Bereich eine eigene Kopierfunktion schreibe und die Funktionen dann der Reihe nach aufrufe.

#12

Ich verstehe das Problem nicht so richtig. Du kannst doch einfach beliebig viele Copy-Past-Aktionen hintereinander ausführen.

Ingo

#13

Hallo,
ich sehe gerade, dass die kopierten Bereiche transponiert eingefügt werden sollen (Transpose:=True). Dann ist es klar, dass die vorher eingefügten Bereiche wieder überschrieben werden. Falls das Transponieren nicht erforderlich sein sollte, einfach abändern auf Transpose:=false oder falls Das transponierte doch gewünscht sein sollte, die Bereiche, in welchen das Einfügen erfolgen soll, abändern auf z.B.:
Statt Range(„G“ & intA).Select Range(„Z“ & intA).Select
Statt Range(„H“ & intA).Select Range(„AN“ & intA).Select

Dieser Weg scheint nicht zu funktionieren. Da er irgendwie die
Bereiche schreibt und dann wieder überschreibt.

#14

Hallo,
Du kannst nicht mehrere unzusammenhängende Bereiche kopieren und dann genau so in eine andere Tabelle einfügen.
Dir bleibt also nichts anderes, als jeden Bereich einzeln zu kopieren.
Gruß, torvaal