-1

I am new to VBA formulas in Excel.

I have a workbook with multiple sheets which needs to be copied (only values) in a master sheet in the same workbook. The problem is I get an error on one of my sheets:

Runtime error 1004:
The information cannot be pasted because the Copy area and the paste area are not the same size and shape.

I noticed that this error occurs only if I have only one row in my table that is not blank.

Here is my Code:

Sub MockImportNewData()

Application.ScreenUpdating = False

        Sheets("BLUGI").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("PANT").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("BLUZE").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("PULOVER").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("FUSTE").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("ROCHII").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("GECI").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("GEANTA").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("ACCESORII").Select
        Range("A4:G4").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("MASTER").Select
        Range("A3").Select
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets("Master").Select
        Range("A5").Select

        End Sub
Roberto
  • 21
  • 7
  • 4
    Holy frickin .select, Batman... – Cyril Mar 28 '18 at 14:43
  • 2
    @Cyril that is a select comment if ever I saw one – 3-14159265358979323846264 Mar 28 '18 at 14:48
  • 2
    I suggest reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) use that information to refactor your entire code completely and then come back with your clean code and without `.Select`. You should be able to condense that code to less than 20 lines I think. – Pᴇʜ Mar 28 '18 at 14:51
  • 1
    And work up from the bottom. If you use Down with only one cell you will go to the last row and then you can't offset a further row down because you will be off the edge of Excel world. – SJR Mar 28 '18 at 14:52

2 Answers2

0

This hurt me to read through... consolidation time, plus dynamic last row:

Sub MockImportNewData()
    Dim lr as Long, olr as Long
    Application.ScreenUpdating = False
    With Sheets("BLUGI")
        lr = Sheets("Master").Cells(Sheets("Master").Rows.Count, 1).End(xlUp).Row
        olr = .Cells(4,1).End(xlDown).Row
        .Range("A4:G" & ).Copy
        Sheets("MASTER").Range( Sheets("MASTER").Cells(lr+1, 1), Sheets("MASTER").Cells(lr+olr+1,7)).PasteSpecial Paste:=xlPasteValues
    End With
    With Sheets("PANT")
        lr = Sheets("Master").Cells(Sheets("Master").Rows.Count, 1).End(xlUp).Row
        olr = .Cells(4,1).End(xlDown).Row
        .Range("A4:G" & .Cells(4,1).End(xlDown).Row).Copy
        Sheets("MASTER").Range( Sheets("MASTER").Cells(lr+1, 1), Sheets("MASTER").Cells(lr+olr+1,7)).PasteSpecial Paste:=xlPasteValues            
    End With
    Application.CutCopyMode = False

'Start with the above and work from there
'You may want to find the CONTIGUOUS (that's the real word) range to find the last row
'Any breaks in the contiguous range will break .End(xlDown)
Cyril
  • 6,448
  • 1
  • 18
  • 31
  • 1
    `.Cells(4,1).End(xlDown)` is missing a `.Row` (twice) – Pᴇʜ Mar 28 '18 at 15:21
  • `.Range("A4:G" & .Cells(4, 1).End(xlDown)).Copy` gives me "Runtime-error 1004 application defined or object-defined error" – Roberto Mar 28 '18 at 15:21
  • @Roberto my bad; I forgot to add in .Row after the .End() See my edit. – Cyril Mar 28 '18 at 15:42
  • Same problem, **"Runtime-error 1004 PasteSepcial method of Range class failed"** `With Sheets("PULOVER") lr = Sheets("c").Cells(Sheets("c").Rows.Count, 1).End(xlUp).Row .Range("A4:G" & .Cells(4, 1).End(xlDown).Row).Copy Sheets("c").Cells(lr + 1, 1).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End With` – Roberto Mar 28 '18 at 17:40
  • for some reason it sees this particular sheet as if it is blank ,but it's not.It just has only one row of data (A4:G4) but if i write another row of data,it has no problem....I don't understand why – Roberto Mar 28 '18 at 17:42
  • @Roberto I think I know what it is... pastespecial is requiring a whole range to paste into, so it can list values only. If you were to just paste, it wouldn't be an issue. Will update code in a sec to show that range. – Cyril Mar 28 '18 at 18:24
  • @Roberto Note the addition of olr (other last row) – Cyril Mar 28 '18 at 18:30
  • @Cyril for your interest, the issue here is `xlDown` in `.Cells(4,1).End(xlDown).Row` because if row 4 is the only data row `xlDown` will go until the very end of the worksheet and copy that all. But when you try to paste that it exceeds the rows of the master sheet (just too many rows were copied). Therefore `.Cells(.Rows.Count, 1).End(xlUp).Row` would work better (together with a check that it has to be ≥ 4) see in my answer aswell. – Pᴇʜ Mar 29 '18 at 06:07
  • @Pᴇʜ thanks for the follow-up! I was thinking he used that specifically because of non-contiguous data (hence my comment about finding a contiguous data source in the code snippet). – Cyril Mar 29 '18 at 13:11
  • @Cyril Yes, I thought that too at first and only figured out because of his comment at my answer, where he tells that there is only one row of data in row 4 of one of the sheets. – Pᴇʜ Mar 29 '18 at 13:13
0

Since all worksheets seem to have the same structure you can just loop through the sheet names:

Option Explicit

Public Sub MockImportNewData()
    Dim SheetNames As Variant
    SheetNames = Array("BLUGI", "PANT", "BLUZE", "PULOVER", "FUSTE", "ROCHII", "GECI", "GEANTA", "ACCESORII")

    Application.ScreenUpdating = False           

    Dim SheetName As Variant
    For Each SheetName In SheetNames
        Dim lr As Long

        With Worksheets(SheetName)
            lr = .Cells(.Rows.Count, 4).End(xlUp).Row 
            If lr < 4 Then
                MsgBox "Nothing to copy in: " & SheetName
                GoTo NextIteration
            End If
            .Range("A4:G" & lr).Copy
        End With

        With Worksheets("Master")
            lr = .Cells(.Rows.Count, 1).End(xlUp).Row
             .Cells(lr + 1, 1).PasteSpecial Paste:=xlPasteValues
        End With

        Application.CutCopyMode = False

NextIteration:
    Next SheetName

    Application.ScreenUpdating = True
End Sub

Probably a good idea to additionally implement an error handling if SheetName is not found.

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
  • `.Cells(lr + 1, 1).PasteSpecial Paste:=xlPasteValues` give me "Runtime-error 1004 PasteSepcial method of Range class failed" – Roberto Mar 28 '18 at 15:33
  • @Roberto This happened because of a sheet with no data in it. see my edited answer. – Pᴇʜ Mar 28 '18 at 15:43
  • 1
    it manages to copy the first 3 sheets **BLUGI** , **PANT** , **BLUZE** ,but for some reason it stops at the 4th sheet **PULOVER** . I suspect that it has something to do with the fact that I have only 1 row of data(A4:G4) in that sheet . – Roberto Mar 28 '18 at 15:46
  • @Roberto then see my edit again. I changed how the last row is found – Pᴇʜ Mar 28 '18 at 15:54
  • It Worked! Thanks a lot! – Roberto Mar 28 '18 at 17:22