Option
Explicit
Dim
oWbk
As
Workbook
Dim
oWsh
As
Worksheet
Dim
aBlock(), bBlock()
Private
Sub
CMD_Copy_Click()
Dim
sc
As
Range, st
As
Range
If
ListBoxB.ListIndex < 0
Or
ListBoxB.ListIndex < 0
Then
Call
MsgBox(
"keine gültige Auswahl!"
, vbCritical,
"Abbruch"
)
Exit
Sub
End
If
With
oWsh
Set
sc = .Range(ListBoxB.Column(0))
Set
st = .Range(ListBoxA.Column(0))
Select
Case
MsgBox(
"von "
& sc.Address &
" - nach "
& st.Address, _
vbOKCancel
Or
vbInformation
Or
vbDefaultButton1,
"CMD_Copy"
)
Case
vbOK
sc.Copy
st.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode =
False
sc.Cells(1).
Select
RefreshLists
Case
vbCancel
End
Select
End
With
End
Sub
Private
Sub
SpinButton1_Change()
Select
Case
SpinButton1.Value
Case
0
With
ListBoxA
.Clear
.List = aBlock
End
With
With
ListBoxB
.Clear
.List = bBlock
End
With
Case
1
With
ListBoxA
.Clear
.List = bBlock
End
With
With
ListBoxB
.Clear
.List = aBlock
End
With
End
Select
End
Sub
Private
Sub
UserForm_Deactivate()
Set
oWbk =
Nothing
Set
oWsh =
Nothing
End
Sub
Private
Sub
UserForm_Initialize()
Set
oWbk = ThisWorkbook
Set
oWsh = oWbk.Sheets(
"Export"
)
RefreshLists
End
Sub
Private
Sub
RefreshLists()
Dim
n
As
Name, acnt
As
Long
, bcnt
As
Long
Dim
c
As
Range
oWsh.Activate
For
Each
n
In
oWbk.Names
If
Left(n.Name, 5) =
"Block"
Then
Select
Case
Right(n.Name, 1)
Case
"a"
acnt = acnt + 1
Case
"b"
bcnt = bcnt + 1
End
Select
End
If
Next
n
ReDim
aBlock(1
To
acnt, 0
To
3)
ReDim
bBlock(1
To
acnt, 0
To
3)
acnt = 0: bcnt = 0
For
Each
n
In
oWbk.Names
If
Left(n.Name, 5) =
"Block"
Then
Select
Case
Right(n.Name, 1)
Case
"a"
acnt = acnt + 1
Set
c = n.RefersToRange
aBlock(acnt, 0) = c.Address
aBlock(acnt, 1) = n.Name
Set
c = Range(aBlock(acnt, 0))
aBlock(acnt, 2) = c.Cells(4).Value
aBlock(acnt, 3) = c.Cells(5).Value
Case
"b"
bcnt = bcnt + 1
Set
c = n.RefersToRange
bBlock(bcnt, 0) = c.Address
bBlock(bcnt, 1) = n.Name
Set
c = Range(bBlock(bcnt, 0))
bBlock(bcnt, 2) = c.Cells(4).Value
bBlock(bcnt, 3) = c.Cells(5).Value
End
Select
End
If
Next
n
With
ListBoxA
.ColumnCount = 4
.ColumnWidths =
"0; 60 ; 60; 60"
.Clear
.List = aBlock
End
With
With
ListBoxB
.ColumnCount = 4
.ColumnWidths =
"0; 60 ; 60; 60"
.Clear
.List = bBlock
End
With
End
Sub