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 'Zeile mit Datum in Quelle
myDate = wksQ.Cells(s, 1).Value
wksZ.Activate
For r = 2325 To count_rowZ 'Zeile mit Datum in Ziel
If wksZ.Cells(r, 3).Value = myDate Then
wksQ.Activate
For u = 82 To 94 'Spalte mit Name in Quelle
myName = wksQ.Cells(13, u).Value
wksZ.Activate
For t = 14 To count_columnZ 'Spalte mit Name in Ziel
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
|