Copy+Paste variable range from different sheets in a worksheet

[Rosixks]

Hi there,

I am trying since a couple of weeks to produce a code...but I really not getting it right. I would be very pleased if someone could help me!! I dont even think that what I am looking for is complicated...here it is:

I have a workbook with over 150 sheets, each of them having a different name but the same structure.

For each worksheet strating at worksheet in position number 4 (so "ignoring" the first three sheets):
> I need to copy the the data from column D, starting at D12 and until the first empty cell comes
> I want to paste it in the sheet called "Summary" in the first empty cell in column B, and copy in column A the name of the sheet from which the value has been copied

Could anyone help me?? I would really appreciate any help, since I am not really getting it by myself.

Thanks in advance!

[tigeravatar]

Rosixks,

Give this a try:

Sub tgr()
    
    Dim AppCalc As Integer: AppCalc = Application.Calculation
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim wsI As Long
    Dim rngC As Range
    Dim rngP As Range
    
    For wsI = 4 To Sheets.Count
        Set rngC = Range(Sheets(wsI).Range("D12"), Sheets(wsI).Cells(Rows.Count, "D"))
        If rngC.Row >= 12 Then
            Set rngP = Sheets("Summary").Cells(Rows.Count, "B").End(xlUp).Offset(1)
            rngC.Copy rngP
            rngP.Offset(, -1).Resize(rngC.Cells.Count).Value = Sheets(wsI).Name
        End If
    Next wsI
    
    Application.ScreenUpdating = True
    Application.Calculation = AppCalc
    
End Sub

[Rosixks]

Thanks for your help! It is actually not working because of the "Resize"(it is giving an error on that line). Here is the code that I have so far...do you think that could be possible to use it and addapt it to do implement the two changes that I need?

Dim ws As Worksheet, wsSUM As Worksheet

Set wsSUM = Sheets("Summary")

wsSUM.Range("A2", wsSUM.Range("A2").End(xlDown)).ClearContents
wsSUM.Range("B2", wsSUM.Range("B2").End(xlDown)).ClearContents

For Each ws In Worksheets 'how could I change this so that it is copying starting at 'worksheet 3 instead
If ws.Name <> "Summary" Then
ws.Range("C5", ws.Range("C5").End(xlDown)).Copy _
wsSUM.Range("B" & wsSUM.Rows.Count).End(xlUp).Offset(1)
wsSUM.Range("A" & wsSUM.Rows.Count).End(xlUp).Offset(1).Value = ws.Name 'how could I change this so that the wsName is copied in Columm A depending on the 'values of Columm B
End If
Next ws
wsSUM.Select