data without formulas returned

[KlausW]

Hello everyone
I use this VBA code to import data from multiple files, it works really well.
But in column K in the source file there are some formulas with values, now I would like the data without formulas returned.
Anyone who can help?
Any help will be appreciated.
Best Regards
Klaus W

Sub Master_Rektangelafrundedehjørner2_Klik()



Dim stgF As String, stgP As String

Dim wb As Workbook

Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Master") 'Assuming that "Master" is the destination sheet name.



stgP = "D:\DNBR 2024\Hoffet\Hoffet overigt over middage og receptioner\" '---->Insert your file path.

stgF = Dir(stgP & "\*.xls*")





Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Application.DisplayAlerts = False



Do While stgF <> vbNullString



Set wb = Workbooks.Open(stgP & "\" & stgF)



With wb.Sheets(1)

.UsedRange.Offset(2).Copy ws.Range("A" & Rows.Count).End(3)(2)

ws.Columns.AutoFit

End With



wb.Close Save = False

stgF = Dir()

Loop



Application.Calculation = xlCalculationAutomatic

Application.DisplayAlerts = True

Application.ScreenUpdating = True

Application.DisplayCommentIndicator = xlNoIndicator



Worksheets("Master").Cells.EntireRow.AutoFit



End Sub

 

[Vogateer]

Do you need only the values and not the formatting for the whole sheet? If so, I think this will work. so long as the ranges in the changed line are the same size:

Sub Master_Rektangelafrundedehjørner2_Klik()

Dim stgF As String, stgP As String
Dim wb As Workbook, ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Master") 'Assuming that "Master" is the destination sheet name.

stgP = "D:\DNBR 2024\Hoffet\Hoffet overigt over middage og receptioner\" '---->Insert your file path.
stgF = Dir(stgP & "\*.xls*")

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Do While stgF <> vbNullString
    Set wb = Workbooks.Open(stgP & "\" & stgF)
  
    With wb.Sheets(1)
        '.UsedRange.Offset(2).Copy ws.Range("A" & Rows.Count).End(3)(2)
        ' Copy the values only, but ranges must be the same size:
        ws.Range("A" & Rows.Count).End(3)(2).Value2 = .UsedRange.Offset(2).Value2
        ws.Columns.AutoFit
    End With
  
    wb.Close Save = False
    stgF = Dir()
Loop

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayCommentIndicator = xlNoIndicator

Worksheets("Master").Cells.EntireRow.AutoFit

End Sub

 

[KlausW]

Do you need only the values and not the formatting for the whole sheet? If so, I think this will work. so long as the ranges in the changed line are the same size:

Sub Master_Rektangelafrundedehjørner2_Klik()

Dim stgF As String, stgP As String
Dim wb As Workbook, ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Master") 'Assuming that "Master" is the destination sheet name.

stgP = "D:\DNBR 2024\Hoffet\Hoffet overigt over middage og receptioner\" '---->Insert your file path.
stgF = Dir(stgP & "\*.xls*")

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Do While stgF <> vbNullString
    Set wb = Workbooks.Open(stgP & "\" & stgF)
 
    With wb.Sheets(1)
        '.UsedRange.Offset(2).Copy ws.Range("A" & Rows.Count).End(3)(2)
        ' Copy the values only, but ranges must be the same size:
        ws.Range("A" & Rows.Count).End(3)(2).Value2 = .UsedRange.Offset(2).Value2
        ws.Columns.AutoFit
    End With
 
    wb.Close Save = False
    stgF = Dir()
Loop

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayCommentIndicator = xlNoIndicator

Worksheets("Master").Cells.EntireRow.AutoFit

End Sub

Hi Vogateer it doesn't work it only takes cells A3 and A4. Sincerely, Klaus W

 

[KlausW]

Hi Vogateer it doesn't work it only takes cells A3 and A4. Sincerely, Klaus W

Hi Vogateer I only need the value

 

[Alex Blakenburg]

Try changing the With wb.Sheets(1) section with this:

    With wb.Sheets(1)
        '.UsedRange.Offset(2).Copy ws.Range("A" & Rows.Count).End(3)(2)
        ' Copy the values only, but ranges must be the same size:
        With .UsedRange.Offset(2)
            ws.Range("A" & Rows.Count).End(3)(2).Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
        End With
        ws.Columns.AutoFit
    End With

 

[KlausW]

Try changing the With wb.Sheets(1) section with this:

    With wb.Sheets(1)
        '.UsedRange.Offset(2).Copy ws.Range("A" & Rows.Count).End(3)(2)
        ' Copy the values only, but ranges must be the same size:
        With .UsedRange.Offset(2)
            ws.Range("A" & Rows.Count).End(3)(2).Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
        End With
        ws.Columns.AutoFit
    End With

Hi
Alex Blakenburg it copies as it should but it does not include the comments that are in columns C:J, can you help? Regards Klaus W

 

[Alex Blakenburg]

OK can you replace the whole section I gave you last time from With to End With, and use this instead.

    wb.Sheets(1).UsedRange.Offset(2).Copy
    With ws.Range("A" & Rows.Count).End(3)(2)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteComments
    End With
    ws.Columns.AutoFit

 

[KlausW]

OK can you replace the whole section I gave you last time from With to End With, and use this instead.

    wb.Sheets(1).UsedRange.Offset(2).Copy
    With ws.Range("A" & Rows.Count).End(3)(2)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteComments
    End With
    ws.Columns.AutoFit

Hi Alex Blakenburg as it should be, thank you, have a nice day, from Denmark Klaus W

 

[Alex Blakenburg]

Thanks for letting us know. Glad we could help.