Consolidate my sheets with formulas

[KlausW]

Hi, I have a little challenge. I use this VBA code to consolidate my sheets. It works really well. Now I have inserted formulas in columns A to H. When I run the VBA code, it does not run. I think it must be because formulas have come in. Some that can help get it running.
All help will be appreciated.
Best Regards
Klaus W

Sub Rektangelafrundedehjørner4_Klik()

    Dim ws As Worksheet, wsConsol As Worksheet
    Dim lngLastRow As Long, lngPasteRow As Long
   
    Application.ScreenUpdating = False
   
    Set wsConsol = ThisWorkbook.Sheets("Bestilling")
    lngPasteRow = 9 'Starting Row number for the consolidation of the sheet data in 'wsConsol'.
   
    For Each ws In ThisWorkbook.Sheets
        

        If ws.Name <> wsConsol.Name And ws.Name <> "Fra fil" Then


        'If ws.Name <> wsConsol.Name Then
            On Error Resume Next
                lngLastRow = ws.Range("A:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            On Error GoTo 0
            If lngLastRow >= 2 Then
                ws.Range("A2:I" & lngLastRow).Copy Destination:=wsConsol.Range("K" & lngPasteRow)
                lngPasteRow = wsConsol.Range("K:S").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
            End If
        End If
    Next ws

           
            Range("K9:K15000").NumberFormat = "General"
            Range("K9:K15000").Value = Range("K9:K15000").Value
    
    
   
    Application.ScreenUpdating = True
    
    Sheets("Bestilling").Select
    Macro1

End Sub

 

[DanteAmor]

Try this:

Sub Rektangelafrundedehjørner4_Klik()
  Dim ws As Worksheet, wsConsol As Worksheet
  Dim lngLastRow As Long, lngPasteRow As Long
  
  Application.ScreenUpdating = False
  
  Set wsConsol = ThisWorkbook.Sheets("Bestilling")
  lngPasteRow = 9 'Starting Row number for the consolidation of the sheet data in 'wsConsol'.
  
  For Each ws In ThisWorkbook.Sheets
    Select Case ws.Name
      Case wsConsol.Name, "Fra fil"
      Case Else
        On Error Resume Next
        lngLastRow = ws.Range("A:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        On Error GoTo 0
        If lngLastRow >= 2 Then
          ws.Range("A2:I" & lngLastRow).Copy
          wsConsol.Range("K" & lngPasteRow).PasteSpecial xlPasteValues
          wsConsol.Range("K" & lngPasteRow).PasteSpecial xlPasteFormats
          lngPasteRow = wsConsol.Range("K:S").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        End If
    End Select
  Next ws
  
  wsConsol.Range("K9:K" & lngPasteRow).NumberFormat = "General"
  Application.ScreenUpdating = True
  Sheets("Bestilling").Select
  Macro1
End Sub

 

[KlausW]

Hi Dante Amor it work perfekt, thank very much. Best regards Klaus W

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[alansidman]

Here is a non VBA option available to you using Power Query