AW: Inhalt zwischen Dateien kopieren
05.03.2009 16:56:45
Martin
Hey Jürgen und Ramses ,
ihr zwei habt mir sehr geholfen.... mit euren Ansätzen konnte ich folgende Lösung erarbeiten:
Public Store As Integer
Public i As Integer
Public WB_Source As Workbook
Public WB_Target As Workbook
Public Target_Name2 As String
Public RoG As Integer
Public RuG As Integer
Public Source_RoG As Integer
Public Source_RuG As Integer
Public Target_RoG As Integer
Public Target_RuG As Integer
Public ZielBereich As String
Public ZielBereich_Source As Range
Public ZielBereich_Target As Range
Public Sub Start()
Call Namen_WBSheets
UserForm1.Hide
End Sub
Public Sub öffnen(ByRef Target_Name)
Source_Name = ThisWorkbook.Name
If Target_Name2 = "" Then
If Target_Name = "" Then
End If
End If
Source_Name = ThisWorkbook.Name
source_aktWB = ThisWorkbook.ActiveSheet.Name
Workbooks(Source_Name).Activate
Set ZielBereich_Source = Workbooks(Source_Name).Application.InputBox("Bitte Quelle wählen", _
Type:=8)
ZielBereich = ZielBereich_Source.Address
MsgBox ZielBereich
RoG_RuG_bestimmen RoG, RuG
Source_RoG = RoG
Source_RuG = RuG
Repeat:
Workbooks(Target_Name).Activate
Target_AktWB = Workbooks(Target_Name).ActiveSheet.Name
Set ZielBereich_Target = Workbooks(Target_Name).Application.InputBox("Bitte Zielbereich wählen", _
Type:=8)
ZielBereich = ZielBereich_Target.Address
Target_AktWB = ZielBereich_Target.Worksheet.Name
MsgBox ZielBereich
RoG_RuG_bestimmen RoG, RuG
Target_RoG = RoG
Target_RuG = RuG
'Coulumns als Array definieren
cols = Array(1, 2, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 19, 21, 27, 29, 37, 38, 39, 40, 41, 42, 43, _
44)
Targetzeilen = Target_RuG - Target_RoG
Sourcezeilen = Source_RuG - Source_RoG
If Targetzeilen
Public Function RoG_RuG_bestimmen(ByRef RoG, ByRef RuG)
Dim strLength As Integer
Dim i As Integer
Dim dein_string
Dim dummy As String
Dim result As String
Dim RangeOberGrenze As String
Dim RangeUnterGrenze As String
RoG = "0"
RuG = "0"
trenner = InStr(ZielBereich, ":")
If trenner = 0 Then
strLength = Len(ZielBereich)
RangeOberGrenze = ZielBereich
RangeUnterGrenze = ZielBereich
GoTo Nächste
End If
RangeOberGrenze = Left(ZielBereich, trenner)
RangeUnterGrenze = Right(ZielBereich, trenner)
Nächste:
strLength = Len(RangeOberGrenze) 'Länge wird überprüft
For i = 1 To strLength
dummy = Mid(RangeOberGrenze, i, 1)
If IsNumeric(dummy) Then
RoG = RoG & dummy
End If
Next i
strLength = Len(RangeUnterGrenze) 'Länge wird überprüft
For i = 1 To strLength
dummy = Mid(RangeUnterGrenze, i, 1)
If IsNumeric(dummy) Then
'IsNumeric fragt ab ob es sich um einen Integerwert handelt, Rückgabewert true/false
RuG = RuG & dummy
End If
Next i
End Function
Sub Namen_WBSheets()
Dim i As Variant
a = Application.Workbooks.Count
For i = 1 To a
Text = Application.Workbooks(i).Name
UserForm1.ComboBox1.AddItem Text
Next
UserForm1.Show
End Sub
Userform1:
Private Sub CommandButton1_Click()
Target_Name = UserForm1.ComboBox1.Value
öffnen (Target_Name)
End Sub
Private Sub CommandButton2_Click()
Dim lngCount As Long
' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
' Display paths of each file selected
For lngCount = 1 To .SelectedItems.Count
MsgBox .SelectedItems(lngCount)
Set WB_Target = Workbooks.Open(.SelectedItems(lngCount), ReadOnly:=False, editable:=True)
Target_Name = ActiveWorkbook.Name
Next lngCount
End With
Call öffnen(Target_Name)
End Sub
Vielen herzlichen Dank!
Viele Grüße
Martin