Reputation: 11
I want to Copy a set of Data from another Workbook and my code copies it under the last set. Im Copying from Sheet "Übersciht" to Sheet "Daten". I want the date to be Pasted in every pasted row in "Daten" as soon as I paste the Data set
Sub Schaltfläche1_Klicken()
Application.DisplayAlerts = False
Dim LastRow As Long
Dim i As Long
Dim mWB As Workbook 'This Workbook
Dim dWB As Workbook 'Data Workbook
'set the Main Workbook
Set mWB = ThisWorkbook
Dim filePath As String
filePath = Application.GetOpenFilename
Debug.Print filePath
'Set the Data Workbook
Set dWB = Workbooks.Open(filePath)
Dim dataSh As Worksheet
Set dataSh = dWB.Sheets("Fuhrparksteuerung XLS Export")
'copy the Data Table
dataSh.Range("A1").CurrentRegion.Copy
'Paste the Data Table
mWB.Sheets("Übersicht").Range("A1").PasteSpecial xlPasteAll
dWB.Close False
Application.DisplayAlerts = True
With ThisWorkbook.ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
LastRow = Sheets("Daten").Range("B65536").End(xlUp).Offset(1, 0).Row
Range("A4:M25").Copy Destination:=Sheets("Daten").Range("B" & LastRow)
Sheets("Daten").Range("A" & LastRow) = Range("A2").Value
End Sub
I tried this code to copy/paste, but i need the Date from Cell A2 to be pasted into every pasted row in "Daten" Sheet .
It should look like this after pasting.
Please help me, thank you very much :)
Upvotes: -1
Views: 86
Reputation: 6418
Try the following to copy the the data from the "Übersicht" sheet below existing data in the "Daten" sheet:
LastRowU = mWB.Sheets("Übersicht").Range("B65536").End(xlUp).Row + 1
LastRowD = mWB.Sheets("Daten").Range("B65536").End(xlUp).Row
Sheets("Daten").Range("A" & LastRowD & ":A" & LastRowD + LastRowU).Value = mWB.Sheets("Übersicht").Range("A2").Value
Sheets("Daten").Range("B" & LastRowD & ":M" & LastRowD + LastRowU).Value = mWB.Sheets("Übersicht").Range("B2:M" & LastRowU).Value
(Note: I did not test this code)
Upvotes: 0