VBA copy range from multiple sheets into one, adding the sheet name

[AriannaVV]

Hi everyone!
I found in this forum (VBA - Copy and Paste Range From Multiple Sheets into Summary) the following code (changed somehow in order to transfer various ranges of cells from specific sheets in a new sheet called "summary"). Works great but when I run again the code to add data below previous copied range, selecting different sheets this time, it ovewrittes the first row and then continues nicely all other rows after the previous last row. Can anyone help to find out what goes wrong?
And another one question. Is it possible to mention the namesheet from where each result comes from? Thank you very much for your kind help.

Sub Copy_Range_From_Sheets_De()

On Error GoTo M
 
Application.ScreenUpdating = False
 Dim i As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("de.").Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = 3
For i = 2 To Lastrow
     ans = Sheets("de.").Cells(i, 1).Value
 With Sheets(ans)
 .Range("e93:o93").Copy
 Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues
  Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
 End With
 With Sheets(ans)

 .Range("e141:o141").Copy
  Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues
   Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
  End With
  Next
  Application.ScreenUpdating = True
 Exit Sub
M:
 MsgBox "You tried to use a sheet name that does not exist" & vbNewLine & "Or we had another problem"
 Application.ScreenUpdating = True
End Sub

 

[offthelip]

After the line:

lastrowA = 3

add this code:

lastrowA = 3
  answer = MsgBox("Do you want to start at row 3?", vbYesNo)
  If answer = vbNo Then
   lastrowA = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
  End If

this will ask whether you want to start at row 3 or carry on from the last position

 

[AriannaVV]

After the line:

lastrowA = 3

add this code:

lastrowA = 3
  answer = MsgBox("Do you want to start at row 3?", vbYesNo)
  If answer = vbNo Then
   lastrowA = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
  End If

this will ask whether you want to start at row 3 or carry on from the last position

That solves the first part of my question. Thank you!!

 

[offthelip]

where do you want the sheet name put?? It is very easy just add this one line of code after the With Sheets(ans)

With Sheets(ans)
 .Range("A1") = .Name  ' add this line which puts it in cell A1
End With

to put it in the last row try this:

With Sheets(ans)
 .Range("A" & lastrowa) = .Name
End With

 

[AriannaVV]

where do you want the sheet name put?? It is very easy just add this one line of code after the With Sheets(ans)

With Sheets(ans)
 .Range("A1") = .Name  ' add this line which puts it in cell A1
End With

to put it in the last row try this:

With Sheets(ans)
 .Range("A" & lastrowa) = .Name
End With

I did as you said but there was no change. Normally the code begins to writte on cell A3 so I wrote .Range("L3") = .Name. But nothing happened.

 

[offthelip]

My mistake, I have just realised that you want it on the summary sheet so change it to:

With Sheets(ans)
Sheets("Summary").Range("L3") = .Name
End With

 

[AriannaVV]

My mistake, I have just realised that you want it on the summary sheet so change it to:

With Sheets(ans)
Sheets("Summary").Range("L3") = .Name
End With

This works somehow but does not do exactly what I need. It only brings one namesheet but I copy various rows from 2 to 4 sheets each time so I need in every change to get the name of the sheet the data where copied from. Is this possible?

 

[MARK858]

You must have put the last code outside the loop, if ans is the sheet name as in the original code, just add the lines below

With Sheets(ans)
 .Range("e93:o93").Copy
 Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues
 Sheets("Summary").Cells(Lastrowa, 12).Value = ans
  Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
 End With
 With Sheets(ans)

 .Range("e141:o141").Copy
  Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues
  Sheets("Summary").Cells(Lastrowa, 12).Value = ans
   Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1
  End With
  Next
  Application.ScreenUpdating = True
 Exit Sub

 

[AriannaVV]

With Sheets(ans) .Range("e9393").Copy Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues Sheets("Summary").Cells(Lastrowa, 12).Value = ans Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1 End With With Sheets(ans) .Range("e141141").Copy Sheets("Summary").Cells(Lastrowa, 1).PasteSpecial xlPasteValues Sheets("Summary").Cells(Lastrowa, 12).Value = ans Lastrowa = Sheets("Summary").Cells(Rows.Count, "A").End(xlUp).Row + 1 End With Next Application.ScreenUpdating = True Exit Sub

Perfect!!!! Exactly what I was looking for. Thank you so much!!

 

[Fluff]

In future please mark the post the contains the solution, not your post saying it works. Thanks