Copying data from multiple sheets and pasting it on a single destination sheet

[SPS41]

Hi, I am fairly new to vba and I am trying to copy data from multiple sheets except from sheet names that are in the defaultsheetnames array.

DefaultSheetNames = Array("Admin", "QBBOM", "Index", "Master", "Template", "Revision Log", "Instructions", "Sample", "Deleted Items", "ChangeLog", "PartValidation", "1ef699ff-cb2f-4875-a1d3-6832011", "Table1")

I would like to copy data from row A11 to the dynamic last row defined by the variable LR (Last Row) from each sheet.

LR = Cells(Rows.Count, 1).End(xlUp).Row

Finally I would like to paste them in the Sheets("Master") starting at row A13 with no formatting to the data copied.

Below are some pictures inserted, they are also attached.

Below is the Picture of the data of an example sheet to be copied. Copy data from a11 (A00) to Last row.

Below is the Picture of the various sheet tab names and the destination sheet layout. Paste data from A13.

I am encountering errors and I do not know where to spot the mistake
Any help would be greatly appreciated.

Sub Master_Creation()



Dim wkbk As Workbook: Set wkbk = ThisWorkbook

Dim wksht As Worksheet

Dim LR As Long, FirstBlankrow As Long

Dim DefaultSheetNames As Variant

'below are the sheet names I dont want data copied from but I want the destination sheet to be Master
DefaultSheetNames = Array("Admin", "QBBOM", "Index", "Master", "Template", "Revision Log", "Instructions", "Sample", "Deleted Items", "ChangeLog", "PartValidation", "1ef699ff-cb2f-4875-a1d3-6832011", "Table1")  






Sheets("Master").Range("A13", "N10000").ClearContents ' clearing data on destination sheet before pasting

For Each wksht In Worksheets 'looping through worksheets

      LR = Cells(Rows.Count, 1).End(xlUp).Row ' hopefully dynamic last row of each worksheet

      If IsInArray(wksht.Name, DefaultSheetNames) = False Then  ' hopefully this doesnt copy data from defaultsheetnames array

            On Error GoTo CompatibilitySheetIssue

            For i = 11 To LR

                    Debug.Print LR

                    FirstBlankrow = wksht("Master").Cells(Rows.Count, 1).End(xlUp).Row + 1  ' starting at first empty row

                    

                    wksht.Rows(i).Copy Destination:=wksht("Master").Rows(FirstBlankrow)

             Next i

       End If

Next wksht





Done:

Exit Sub





CompatibilitySheetIssue:

MsgBox "Please check if anything realted to the Sheets have any errors."

End Sub




Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean

Dim i

For i = LBound(arr) To UBound(arr)

        If arr(i) = stringToBeFound Then

                IsInArray = True

                Exit Function

         End If

Next i

IsInArray = False



End Function

 

[NdNoviceHlp]

Hi SPS41 and Welcome to the Board! You can trial this approach which avoids the copy and paste. Please keep a copy of your wb before trialing this untested code. Not sure what columns you want to transfer but I'm guessing the whole row isn't necessary. This code is A to N columns. HTH. Dave

Sub Master_Creation()
Dim wkbk As Workbook: Set wkbk = ThisWorkbook
Dim wksht As Worksheet, Rng as Range
Dim LR As Long, FirstBlankrow As Long
Dim DefaultSheetNames As Variant

'below are the sheet names I dont want data copied from but I want the destination sheet to be Master
DefaultSheetNames = Array("Admin", "QBBOM", "Index", "Master", _
           "Template", "Revision Log", "Instructions", "Sample", _
           "Deleted Items", "ChangeLog", "PartValidation", "1ef699ff-cb2f-4875-a1d3-6832011", "Table1")

Sheets("Master").Range("A13", "N10000").ClearContents ' clearing data on destination sheet before pasting
For Each wksht In Worksheets 'looping through worksheets
If IsInArray(wksht.Name, DefaultSheetNames) = False Then  ' hopefully this doesnt copy data from defaultsheetnames array
On Error GoTo CompatibilitySheetIssue
LR = wksht.Cells(wksht.Rows.Count, 1).End(xlUp).Row ' hopefully dynamic last row of each worksheet
Set Rng = wksht.Range("A11:N" & LR)
FirstBlankrow = wksht("Master").Cells(wksht("Master").Rows.Count, 1).End(xlUp).Row + 1  ' starting at first empty row
wksht("Master").Cells(FirstBlankrow, 1).Resize(Rng.Rows.Count, _
            Rng.Columns.Count).Cells.Value = Rng.Cells.Value
End If
Next wksht
Exit Sub

CompatibilitySheetIssue:
MsgBox "Please check if anything realted to the Sheets have any errors."
End Sub

Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i
For i = LBound(arr) To UBound(arr)
        If arr(i) = stringToBeFound Then
                IsInArray = True
                Exit Function
         End If
Next i
IsInArray = False
End Function

ps. please use code tags

 

[SPS41]

Hi NdNoviceHlp,

Thanks for the reply and I will test this out and keep you updated. And yes I would like to copy data from A to H only.
Appreciate all the help!

​

 

[NdNoviceHlp]

A to H only. You will need to change this line of code...

Set Rng = wksht.Range("A11:N" & LR)

to...

Set Rng = wksht.Range("A11:H" & LR)

Dave

 

[SPS41]

A

A to H only. You will need to change this line of code...

Set Rng = wksht.Range("A11:N" & LR)

to...

Set Rng = wksht.Range("A11:H" & LR)

Dave

Appreciate all the help. Works perfectly! Thanks a ton!

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave