Sub
CopyPaste_UKCS()
Dim
wksQ
As
Worksheet, wksZ
As
Worksheet
Dim
r
As
Integer
, s
As
Integer
, t
As
Integer
, u
As
Integer
Dim
rngQ
As
Range, rngZ
As
Range
Dim
wbkZ
As
Workbook
Set
wksQ = ThisWorkbook.Worksheets(
"UK"
)
If
IsFileOpen(
"Zieldatei.xlsx"
)
Then
MsgBox
"File is already open!"
Workbooks(
"Zieldatei.xlsx"
).Activate
Else
Set
wbkZ = Workbooks.Open(
"Zieldatei.xlsx"
, UpdateLinks:=
False
)
End
If
Set
wksZ = ActiveWorkbook.Worksheets(
"Data_Daily"
)
count_rowQ = wksQ.Cells(Rows.Count, 1).
End
(xlUp).Row
count_columnQ = wksQ.Cells(13, Columns.Count).
End
(xlToLeft).Column
count_rowZ = wksZ.Cells(Rows.Count, 1).
End
(xlUp).Row
count_columnZ = wksZ.Cells(7, Columns.Count).
End
(xlToLeft).Column
wksQ.Activate
For
s = 21
To
count_rowQ
myDate = wksQ.Cells(s, 1).Value
wksZ.Activate
For
r = 2325
To
count_rowZ
If
wksZ.Cells(r, 3).Value = myDate
Then
wksQ.Activate
For
u = 82
To
94
myName = wksQ.Cells(13, u).Value
wksZ.Activate
For
t = 14
To
count_columnZ
If
wksZ.Cells(7, t).Value = myName
Then
wksZ.Cells(r, t).Value = wksQ.Cells(s, u).Value
End
If
Next
t
Next
u
End
If
Next
r
Next
s
If
Err = 0
Then
MsgBox
"Data import successful!"
End
Sub