Hello together!
I am a new member from Germany and I need som help from you!
I wrote this code below to copy the content of sheet(1) of all
Excel-Files in one specified directory together in one single sheet of
the Workbook containing the Macro, ignoring all formatting, amount of
data, formula etc.
The code works and does everything it should do, if i start it from the
VB-Editor or via ALT+F8.
If i assign a shortcut to the macro, lets say CTRL+SHIFT+z, then the
code stops immediately after opening one of the files to copy.
How can I avoid this and use a shortcut, to make the use easyer for our
customers?
I tried hiding the "incoming" file while importing the sheet and ODBC
(here I got problems with files from different EXCEL-Versions) to
access the files, but I always got problems with stopping code while
using a shortcut to start the macro-code.
Thank you for all help and greetings from Germany

Uwe

Code:


Public Sub Zusammenkopieren()
'
' Zusammenkopieren Makro
' Copyright 16.09.2003, Uwe Christian
'
'
'
Dim vPfadName As String, vDateiname As String, vZelle As String
Dim vFS As FileSearch
Dim vAktDN As String
Dim i As Long, vZeile As Long

vPfadName = InputBox("Bitte den Namen des Datei-Pfades angeben: ",
"PfadName eingeben")
If vPfadName = "" Then Exit Sub
Set vFS = Application.FileSearch

With vFS
.LookIn = vPfadName
.FileName = "*.xls"
If .Execute 0 Then
For i = 1 To .FoundFiles.Count
Application.Workbooks.Open .FoundFiles.Item(i)
vDateiname = ActiveWorkbook.Name
vZelle =
Application.Workbooks(vDateiname).Sheets(1).Range( "A1").SpecialCells(xlLastCell).Address
Range("A1", vZelle).Copy
vZeile =
ThisWorkbook.Sheets(1).Range("A1").SpecialCells(xl LastCell).Row
ThisWorkbook.Sheets(1).Range("A" &
Trim(CStr(vZeile))).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.Workbooks(vDateiname).Close False
Next i
Else
MsgBox "Keine Dateien zum Einfügen gefunden."
End If

End With

End Sub



------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/

Don't use a shortcut that includes the Shift key.

--
Regards,
Tom Ogilvy


"miedelsbacher" wrote in message
...
Hello together!
I am a new member from Germany and I need som help from you!
I wrote this code below to copy the content of sheet(1) of all
Excel-Files in one specified directory together in one single sheet of
the Workbook containing the Macro, ignoring all formatting, amount of
data, formula etc.
The code works and does everything it should do, if i start it from the
VB-Editor or via ALT+F8.
If i assign a shortcut to the macro, lets say CTRL+SHIFT+z, then the
code stops immediately after opening one of the files to copy.
How can I avoid this and use a shortcut, to make the use easyer for our
customers?
I tried hiding the "incoming" file while importing the sheet and ODBC
(here I got problems with files from different EXCEL-Versions) to
access the files, but I always got problems with stopping code while
using a shortcut to start the macro-code.
Thank you for all help and greetings from Germany

Uwe

Code:


Public Sub Zusammenkopieren()
'
' Zusammenkopieren Makro
' Copyright 16.09.2003, Uwe Christian
'
'
'
Dim vPfadName As String, vDateiname As String, vZelle As String
Dim vFS As FileSearch
Dim vAktDN As String
Dim i As Long, vZeile As Long

vPfadName = InputBox("Bitte den Namen des Datei-Pfades angeben: ",
"PfadName eingeben")
If vPfadName = "" Then Exit Sub
Set vFS = Application.FileSearch

With vFS
LookIn = vPfadName
FileName = "*.xls"
If .Execute 0 Then
For i = 1 To .FoundFiles.Count
Application.Workbooks.Open .FoundFiles.Item(i)
vDateiname = ActiveWorkbook.Name
vZelle =

Application.Workbooks(vDateiname).Sheets(1).Range( "A1").SpecialCells(xlLastC
ell).Address
Range("A1", vZelle).Copy
vZeile =
ThisWorkbook.Sheets(1).Range("A1").SpecialCells(xl LastCell).Row
ThisWorkbook.Sheets(1).Range("A" &
Trim(CStr(vZeile))).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.Workbooks(vDateiname).Close False
Next i
Else
MsgBox "Keine Dateien zum Einfügen gefunden."
End If

End With

End Sub



------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/