VBA Code to Copy a defined range from a defined list of Worksheets and paste into another sheet

[HAN91]

Hi,

I am relatively new to VBA in excel and I have tried searching and re-purposing some vba to no avail so I really hope someone can help.
I am trying to copy a set range from a large number of worksheets that can grow in number but will all be named with the same 1st two words "Scoring Template (then followed by a number)"

I have a spreadsheet with a Worksheet named "Laboratory data" (this is the destination sheet for my copied data), Data starts in A2
I need the VBA to search for all Worksheets within the excel document that start with "Scoring Template", I then need it to copy the data held in A:26 to L:26 and Paste into the worksheet named "Laboratory data" starting in cell A2 and adding below and so on.

Could someone help with some code I can execute via a macro?

Thanks

 

[Georgiboy]

Welcome to the forum,

Perhaps the below will help:

Sub test()
    Dim nr As Long, ws As Worksheet, wsLD As Worksheet
   
    Set wsLD = Sheets("Laboratory data")
   
    For Each ws In Sheets
        If Left(ws.Name, 16) = "Scoring Template" Then
            nr = wsLD.Range("A" & Rows.Count).End(xlUp).Row + 1
            wsLD.Range("A" & nr & ":L" & nr).Value = ws.Range("A26:L26").Value
        End If
    Next ws
End Sub

 

[HAN91]

Hi,

Thank you for taking the time to respond. I did try the above which didn't work however I did find a solution. For reference below:

Sub CopyDataToLaboratoryDataSheet()

Dim ws As Worksheet

Dim labDataSheet As Worksheet

Dim sourceRange As Range

Dim lastRow As Long

Dim targetRange As Range

Dim i As Long



' Set the reference to the "Laboratory data" sheet

Set labDataSheet = ThisWorkbook.Sheets("Laboratory Data")



' Find the next available row in "Laboratory data" sheet

lastRow = labDataSheet.Cells(labDataSheet.Rows.Count, "A").End(xlUp).Row

If lastRow = 1 And labDataSheet.Cells(1, 1).Value = "" Then lastRow = 0 ' Check if sheet is empty



' Loop through each worksheet in the workbook

For Each ws In ThisWorkbook.Worksheets

' Check if the worksheet name contains "Scoring Template"

If InStr(1, ws.Name, "Scoring Template") > 0 Then

' Set the source range to copy

Set sourceRange = ws.Range("A26:L26")



' Set the target range in "Laboratory data" sheet

Set targetRange = labDataSheet.Range("A" & lastRow + 1)



' Copy values from source range to target range

For i = 1 To sourceRange.Columns.Count

targetRange.Cells(1, i).Value = sourceRange.Cells(1, i).Value

Next i



lastRow = lastRow + 1 ' Move to the next available row for the next copy

End If

Next ws

End Sub

 

[Georgiboy]

That is strange how it did not work as both codes work in my mock up of the workbook. The only difference I noted was that if there are no header rows in the "Laboratory data" sheet then my version will place the first row of data in row 2 instead of 1.

Glad you found a solution anyway.