copy data from several closed workbooks to one workbook.

[KlausW]

Hi I use this code to copy data from several closed workbooks to one workbook.
It works fine, I've tried to get the code to copy from cell O1 to Q1 and paste it into column X to Z. But I can't get it to work can anyone help.
Any help appreciated
Best regards
Klaus W

Sub Rektangelafrundedehjørner1_Klik()

    Dim sourceFolder As String
    Dim sourceFiles As Object
    Dim sourceFile As Object
    Dim wbSource As Workbook
    Dim wsDestination As Worksheet
    Dim destinationRow As Long
    
Application.ScreenUpdating = False
Application.DisplayAlerts = False

    ' Set the path to the source folder modify accordingly
    sourceFolder = "D:\Frihedsansøgning\Frihedsansøgning"
    
    ' Set the destination worksheet modify sheet name accordingly
    Set wsDestination = ThisWorkbook.Worksheets("Navn")
    
    ' Initialize the destination row
    destinationRow = 1
    
    ' Create a FileSystemObject to work with files in the folder
    Set sourceFiles = CreateObject("Scripting.FileSystemObject").GetFolder(sourceFolder).Files
    
    ' Loop through each file in the folder
    For Each sourceFile In sourceFiles
        ' Check if the file is an Excel file
        If sourceFile.Name Like "*.xls*" Then
            ' Open the source workbook
            Set wbSource = Workbooks.Open(sourceFile.Path)
            
            ' Copy the values from O1 to Q1
            wbSource.Worksheets(1).Range("o1:q1").Copy
            
            ' Paste the values to the destination worksheet
            wsDestination.Range("Z" & destinationRow).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            
            ' Update the destination row for the next set of values
            destinationRow = destinationRow + 1
            
            ' Close the source workbook without saving changes
            wbSource.Close SaveChanges:=False
        End If
    Next sourceFile
    
    ' Clear the clipboard
    Application.CutCopyMode = False
    
    ' Display a message when the copying is complete
    'MsgBox "Copying customer information from files complete."

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[Alex Blakenburg]

What happens if you change the destination from Z to X and change the Transpose from True to False ?

wsDestination.Range("X" & destinationRow).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 

[KlausW]

What happens if you change the destination from Z to X and change the Transpose from True to False ?

wsDestination.Range("X" & destinationRow).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Hi Alex Blankenburg, thank you very much, it works as it should, have a nice weekend from Denmark, Klaus W

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.
PS: Same to you from Australia

 

[Peter_SSs]

Hi Alex Blankenburg, thank you very much, it works as it should,

The marked solution has been changed accordingly as post #3 that you marked is not the solution post in the thread. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers.

I advised you about this only a couple of week ago!

 

[KlausW]

The marked solution has been changed accordingly as post #3 that you marked is not the solution post in the thread. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers.

I advised you about this only a couple of week ago!

Hi Peter Thanks