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

[SBMa]

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

 

[HaHoBe]

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

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

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

 

[SBMa]

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

 

[HaHoBe]

Hi SBMa,

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

Instead of

  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

  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

 

[SBMa]

Many thanks you absolute legend!

SBM