Copying Values between workbooks

CamVilla

New Member
Joined
Feb 8, 2021
Messages
21
Office Version
  1. 2019
Platform
  1. Windows
Iam using the following code to copy values between workbooks, the question is, is there any way that instead of copying the information of each workbook down through rows it is copied by columns detecting the last empty one column?

Sub ()
Dim xRg As Range
Dim xSelItem As Variant
Dim xFileDlg As FileDialog
Dim xFileName, xSheetName, xRgStr As String
Dim xBook, xWorkBook As Workbook
Dim xSheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
xSheetName = "Hoja1" 'HOJA DONDE VA A COPIAR LA INFO
xRgStr = "G7:IV12" 'RANGO DE QUE VA A COPIAR
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
With xFileDlg
If .Show = -1 Then
xSelItem = .SelectedItems.Item(1)
Set xWorkBook = ThisWorkbook
Set xSheet = xWorkBook.Sheets("New Sheet")
xFileName = Dir(xSelItem & "\*.xls", vbNormal)
If xFileName = "" Then Exit Sub
Do Until xFileName = ""
Set xBook = Workbooks.Open(xSelItem & "\" & xFileName)
Set xRg = xBook.Worksheets(xSheetName).Range(xRgStr)
xRg.Copy
xSheet.Range("A65536").End(xlUp).Offset(0, 0).Resize(xRg.Rows.Count, xRg.Columns.Count).Value = xRg.Value
xFileName = Dir()
xBook.Close
Loop
End If
End With
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


For example (numbers are examples of data to be copy from each workbook):
Workbook1: 1 2
Workbook2: 3 4
Workbook3: 5 6

NewSheet:
1 2
3 4
5 6

What I want NewSheet:
123456
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Change this
VBA Code:
xSheet.Range("A65536").End(xlUp).Offset(0, 0).Resize(xRg.Rows.Count, xRg.Columns.Count).Value = xRg.Value
To this
VBA Code:
xSheet.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Resize(xRg.Rows.Count, xRg.Columns.Count) = xRg.Value
and you can either comment the statement below out or delete it, it does nothing except put a range of data on the clipboard without ever pasting it anywhere. The line of code obove does all the copy and paste throug a different method.
VBA Code:
xRg.Copy
 
Upvote 0
Solution

Forum statistics

Threads
1,214,543
Messages
6,120,123
Members
448,947
Latest member
test111

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top