• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 655
  • Last Modified:

Trouble with macro copying columns from one worksheet to another same workbook

I have some code I am trying to use to copy specific columns from one worksheet to another worksheet in the same workbook.  I need help to determine why it doesn't work.  

When code runs it takes you to directory to pick file, deletes some extraneous records than concatenates the record number with the seq num.  Then I want to take specific columns and copy to new worksheet.  This is where it bombs.

I have attached the code I'm using and data file.
1 Solution
Your problem was failure to fully qualify your worksheet references.

I overcame that be creating two worksheet variables: wsOld and wsNew. I then used a With block to minimize the need to reference wsOld. Within that With block, I just need to put a dot before Column, Row, Range or Cells to create a fully qualified reference: .Range("A1"), .Columns(fred), .Rows(1), etc. And where I thought you meant to be referring to the newly added worksheet, I changed the code to read wsNew.Range("A1"), etc.

I also declared all variables. This is both good practice, and something I am forced to do by using Option Explicit at the top of every module sheet. My VBA Editor enforces that good habit because I checked the box to "Require Variable Declaration" in the Tools...Options...Editor menu item.

Finally, there was a discrepancy in the header label for "VIDEO TOLL TRANSACTION #SEQ NUM". Your code omitted the "SEQ NUM" at the end, thereby causing a run-time error. You could fix the problem either by adding the missing text or an asterisk wildcard character.
Sub Hertz_Maryland_FileUploadFormat()
' HertzABG_Phoenix_FileUpload Macro
Dim Filter As String, sText As String, Title As String
Dim FilterIndex As Integer
Dim fileName As Variant
Dim ddue As Long, dst As Long, i1 As Long, iMax As Long, pn As Long, ps As Long, _
    tat As Long, td As Long, tm As Long, vs As Long, x As Long
Dim fred As Range
Dim wsNew As Worksheet, wsOld As Worksheet
' File filters
Filter = "Excel Files (*.xls),*.xls," & _
        "Text Files (*.txt),*.txt," & _
        "All Files (*.*),*.*"
' Default Filter to *.*
FilterIndex = 3
' Set Dialog Caption
Title = "Select a File to Open"
' Select Start Drive & Path

                    '*****Brad had to comment out the next two statements for testing
ChDrive ("I")
ChDir ("I:\Production\File Uploads\Hertz\Maryland EZ Pass\Original")
With Application
    ' Set File Name to selected File
    fileName = .GetOpenFilename(Filter, FilterIndex, Title)
    ' Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With
' Exit on Cancel
If fileName = False Then
    MsgBox "No file was selected."
    Exit Sub
' Open File
End If
Workbooks.Open fileName
Set wsOld = ActiveSheet
    With wsOld
'copies active sheet to new sheet and renames sheet to 'Upload' and deletes unnecessary colmns
        .Name = "Sheet1"

        sText = "Hertz Equipment Rental Corp"
        sText = LCase(sText)
        iMax = .Cells.SpecialCells(xlCellTypeLastCell).Row
        For i1 = iMax To 1 Step -1
            If InStr(1, LCase(.Cells(i1, 3)), sText) <> 0 Then
            End If
        Next i1
        sText = "Hertz Rental Equipment Corp"
        sText = LCase(sText)
        iMax = .Cells.SpecialCells(xlCellTypeLastCell).Row
        For i1 = iMax To 1 Step -1
            If InStr(1, LCase(Cells(i1, 3)), sText) <> 0 Then
            End If
        Next i1
'Concatenate vionum (video Toll transaction# and Seq Num)
        For x = 1 To .Range("A65536").End(xlUp).Row
                .Range("P" & x).Value = (.Range("P" & x).Value & (.Range("Q" & x).Value))
        Next x
        .Cells(1, 17) = "VIDEO TOLL TRANSACTION#"
        Set wsNew = Sheets.Add
        Set fred = .Cells.Find(What:="*", After:=Range("A1"), SearchDirection:=xlPrevious, SearchOrder:=xlByColumns)
        .Columns(fred.Column).Copy Destination:=wsNew.Columns(fred.Column)
        Application.CutCopyMode = True
        ps = WorksheetFunction.Match("PLATE STATE", .Rows("1:1"), 0)
        pn = WorksheetFunction.Match("PLATE", .Rows("1:1"), 0)
        vs = WorksheetFunction.Match("VIDEO TOLL TRANSACTION #SEQ NUM", .Rows("1:1"), 0)
        td = WorksheetFunction.Match("EXIT DATE/TIME", .Rows("1:1"), 0)
        tm = WorksheetFunction.Match("EXIT DATE/TIME", .Rows("1:1"), 0)
        tat = WorksheetFunction.Match("TOTAL DUE", .Rows("1:1"), 0)
        'fat = WorksheetFunction.Match(" Amount Paying ", .Rows("1:1"), 0)
        dst = WorksheetFunction.Match("DATA DATE", .Rows("1:1"), 0)
        ddue = WorksheetFunction.Match("FEE DUE", .Rows("1:1"), 0)
        .Columns(vs).Copy Destination:=wsNew.Range("A1")
        .Columns(td).Copy Destination:=wsNew.Range("B1")
        .Columns(tm).Copy Destination:=wsNew.Range("C1")
        .Columns(ps).Copy Destination:=wsNew.Range("D1")
        .Columns(pn).Copy Destination:=wsNew.Range("E1")
        .Columns(tat).Copy Destination:=wsNew.Range("F1")
        '.Columns(fat).Copy Destination:=wsNew.Range("G1")
        .Columns(dst).Copy Destination:=wsNew.Range("H1")
        .Columns(ddue).Copy Destination:=wsNew.Range("I1")

    End With
End Sub

Open in new window

rhadashAuthor Commented:
Thanks for the detailed response.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

Tackle projects and never again get stuck behind a technical roadblock.
Join Now