Results 1 to 2 of 2

Thread: Copying data from multiple worksheets into new worksheet

  1. #1

    Copying data from multiple worksheets into new worksheet



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi,

    I have problem with this code
    Code:
    Sub KopiaDanychDoNowegoArkusza()    Dim sh As Worksheet
        Dim DestSh As Worksheet
        Dim LastRow As Long
        Dim CopyRng As Range
        Dim DZNextRow As Long
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        'Usuwa 'Dane Zbiorcze' jesli istnieje
        Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.Worksheets("Dane Zbiorcze").Delete
        On Error GoTo 0
        Application.DisplayAlerts = True
        'Dodaje arkusz 'Dane Zbiorcze'
        Set DestSh = ActiveWorkbook.Worksheets.Add
        DestSh.Name = "Dane Zbiorcze"
        'Dodaje naglówki w pierwszym rzedzie
        With DestSh
            .Cells(1, 1).Value = "Nazwa Kina"
            .Cells(1, 2).Value = "Siec"
            .Cells(1, 3).Value = "Miasto"
            .Cells(1, 4).Value = "Województwo"
        End With
            ' zamraza pierwszy rzad
            With ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
                .FreezePanes = True
            End With
            If Not ActiveSheet.AutoFilterMode Then
                ActiveSheet.Range("A1").AutoFilter
            End If
            'zapetla przez wybrane skoroszyty i kopiuje dane do DestSh
            For Each sh In ActiveWorkbook.Worksheets
                If sh.Name <> DestSh.Name Then
                    'Znajduje ostatni wiersz z danymi w arkuszach zródlowych
                    LastRow = sh.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
                    'uzupelnia kolumne które maja byc skopiowane
                    Set CopyRng = sh.Range("A2:D" & LastRow)
                    'Sprawdza czy jest wystarczajaca ilosc wierszy w DestSh do skopiowania danych
                    With DestSh
                        'Find next blank row at bottom of sheet
                        DZNextRow = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1
                        If DZNextRow + LastRow > .Rows.Count Then
                            MsgBox "There are not enough Rows in the Destsh"
                            GoTo ExitTheSub
                        End If
                    End With
                    'kopiuje wartosci/formaty komórek
                    CopyRng.Copy
                    With DestSh.Cells(DZNextRow, 1)
                        .PasteSpecial xlPasteValues
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
               
            End If
        Next
    ExitTheSub:
        Application.Goto DestSh.Cells(1)
        DestSh.Columns.AutoFit
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    after compilation it returns run-time error 91 Object Variable or With Block variable not set.
    When I debug it line by line error shows when it comes to:
    Code:
    ExitTheSub:
        Application.Goto DestSh.Cells(1)
        DestSh.Columns.AutoFit
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End Sub
    and i'm stuck here

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,512
    Articles
    0
    Excel Version
    365
    The code seems to run smoothly here. I think the only reason you'd get that error there is if the DestSh object variable is no longer set to a sheet.
    When the code stops and you choose debug, make sure the Locals pane is visible (Alt + V, then S or View|Locals Window in the drop down menus at the top), where you should see DestSh in the Expression column. What is in the Value column? It should be completely blank (if it says Nothing then something has made it Nothing so you need to find what) and in the Type column it should say something like Worksheet/Sheet6.
    What do you have in there when the code stops?

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •