Macro to copy data from one workbook to another not working properly

SBMa

New Member
Joined
Aug 17, 2022
Messages
8
Office Version
  1. 365
  2. 2021
  3. 2019
Platform
  1. Windows
1) The header remains in the data copied even thought "StartRow := 2"

2) I am able to see all file types even though '"fileFilterPatttern = "Microsoft Excel Workbooks (*.xls*),*.xls*"'
VBA below


Sub ImportText()
'
' ImportText Macro


Dim fileToOpen As Variant
Dim fileFilterPattern As String

Dim wsMaster As Worksheet
Dim wbTextImport As Workbook

Dim lr As Long

Application.ScreenUpdating = False


fileFilterPatttern = "Microsoft Excel Workbooks (*.xls*),*.xls*"

fileToOpen = Application.GetOpenFilename(fileFilterPattern)

If fileToOpen = False Then
' input Cancelled
MsgBox "No file Selected."


Else

Workbooks.OpenText _
Filename:=fileToOpen, _
StartRow:=2, _
DataType:=xlDelimited, _
Tab:=True



Set wbTextImport = ActiveWorkbook


Set wsMaster = ThisWorkbook.Worksheets("Asset Upload Data 2022")


lr = wsMaster.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row



wbTextImport.Worksheets(1).Range("A2").CurrentRegion.Copy wsMaster.Range("C" & lr)


wbTextImport.Close False



End If

Application.ScreenUpdating = True




'
End Sub
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Hi SBMa,

if you use CurrentRegion this will include every cell not limited by an empty column or row. In your case you would include row 1 as well which should have the headers for the columns.

How about
VBA Code:
Sub ImportText()
'
' ImportText Macro

Dim fileToOpen As Variant
Dim fileFilterPattern As String

Dim wsMaster As Worksheet
Dim wbTextImport As Workbook

Dim lr As Long
Dim lImpC As Long
Dim lImpR As Long

Application.ScreenUpdating = False

fileFilterPattern = "Microsoft Excel Workbooks (*.xls*),*.xls*"

fileToOpen = Application.GetOpenFilename(fileFilterPattern)

If fileToOpen = False Then
  ' input Cancelled
  MsgBox "No file Selected."
Else

  Workbooks.OpenText _
    Filename:=fileToOpen, _
    StartRow:=2, _
    DataType:=xlDelimited, _
    Tab:=True

  Set wbTextImport = ActiveWorkbook
  Set wsMaster = ThisWorkbook.Worksheets("Asset Upload Data 2022")

  lr = wsMaster.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
  lImpC = wbTextImport.Cells(1, Columns.Count, 1).End(xlToLeft).Column
  lImpR = wbTextImport.Cells(Rows.Count, 1).End(xlUp).Row

  With wbTextImport.Worksheets(1)
    .Range("A2", .Cells(lImpR, lImpC)).Copy wsMaster.Range("C" & lr)
  End With
'  wbTextImport.Worksheets(1).Range("A2").CurrentRegion.Copy wsMaster.Range("C" & lr)

  wbTextImport.Close False

End If

Application.ScreenUpdating = True
'
End Sub
or
VBA Code:
Sub ImportText_2()
'
' ImportText Macro

Dim fileToOpen As Variant
Dim fileFilterPattern As String

Dim wsMaster As Worksheet
Dim wbTextImport As Workbook

Dim lr As Long

Application.ScreenUpdating = False

fileFilterPattern = "Microsoft Excel Workbooks (*.xls*),*.xls*"

fileToOpen = Application.GetOpenFilename(fileFilterPattern)

If fileToOpen = False Then
  ' input Cancelled
  MsgBox "No file Selected."
Else

  Workbooks.OpenText _
    Filename:=fileToOpen, _
    StartRow:=2, _
    DataType:=xlDelimited, _
    Tab:=True

  Set wbTextImport = ActiveWorkbook
  Set wsMaster = ThisWorkbook.Worksheets("Asset Upload Data 2022")

  lr = wsMaster.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

  With wbTextImport.Worksheets(1).UsedRange
    .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Copy wsMaster.Range("C" & lr)
  End With

  wbTextImport.Close False

End If

Application.ScreenUpdating = True
'
End Sub
Ciao,
Holger
 
Upvote 0
Thank you so much for the help, neither are working for me unfortunately.
In the first one an error at line "lImpC = wbTextImport.Cells(1, Columns.Count, 1).End(xlToLeft).Column" saying runtime error 438 Object doesnt support this method.

The second method is able to copy over the code but causes an issue with a formula I have in the column next to where my data is. (pictured below).
I think this is because the area being copied over extends past the bottom of the data. This means that I can't use the macro more than once
 

Attachments

  • Screenshot 2022-08-18 114917.png
    Screenshot 2022-08-18 114917.png
    90 KB · Views: 11
Upvote 0
Hi SBMa,

I should jave remembered that a range is located in a worksheet and not a workbook - my bad. :eek:

Instead of
VBA Code:
  lr = wsMaster.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
  lImpC = wbTextImport.Cells(1, Columns.Count, 1).End(xlToLeft).Column
  lImpR = wbTextImport.Cells(Rows.Count, 1).End(xlUp).Row

  With wbTextImport.Worksheets(1)
    .Range("A2", .Cells(lImpR, lImpC)).Copy wsMaster.Range("C" & lr)
  End With
try
VBA Code:
  lr = wsMaster.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

  With wbTextImport.Worksheets(1)
    lImpC = .Cells(1, .Columns.Count, 1).End(xlToLeft).Column
    lImpR = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("A2", .Cells(lImpR, lImpC)).Copy wsMaster.Range("C" & lr)
  End With
Maybe add a check for data to the formula?

Ciao,
Holger
 
Upvote 0
Solution

Forum statistics

Threads
1,223,098
Messages
6,170,103
Members
452,302
Latest member
TaMere

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