macro not copying data to the correct destination file

[zack8576]

I have an xlsb file that contains VBA macros, a csv file that contains a bunch of values. (when the macro is running, the csv file is already open)
And I need to open a xlsm file and copy a range of data from this file to a range of cells in the csv. code below is copying the data to the xlsb file for some reason
I defined wb2, ws2 as csv, wb3 and ws3 are the xlsm. I must be missing something very simple here...

Sub OpenQuoteFile()
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim wb3 As Workbook
    Dim ws3 As Worksheet
    Application.ScreenUpdating = False

    Dim FileName As Variant
    FileName = Application.GetOpenFilename(filefilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm", MultiSelect:=False)

    If FileName = False Then Exit Sub
    Set wb2 = ActiveWorkbook
    Set ws2 = ActiveSheet
    Set wb3 = Workbooks.Open(FileName)
    Set ws3 = wb3.Worksheets("QUOTE")
    
    wb2.Activate
    ws2.Activate

    Dim i As Long
    For i = 19 To 46
        If ws3.Range("D" & i).Value <> "" Then
            ws3.Range("D" & i).Copy
            ws2.Range("S" & i - 18).PasteSpecial xlPasteValues 'Copy as values
            If ws3.Range("D" & i).MergeCells Then
                ws2.Range("S" & i - 18).UnMerge
            End If
        End If
    Next i

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[JoeMo]

Most likely, the code you posted is in your xlsb workbook and is run from that workbook. So these lines:

Set wb2 = ActiveWorkbook
Set ws2 = ActiveSheet

Assign wb2 and ws2 to your xlsb workbook, not your csv workbook.

 

[zack8576]

Most likely, the code you posted is in your xlsb workbook and is run from that workbook. So these lines:

Set wb2 = ActiveWorkbook
Set ws2 = ActiveSheet

Assign wb2 and ws2 to your xlsb workbook, not your csv workbook.

thank you Joe, so something like this would be better ?

Sub OpenQuoteFile()
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim wb3 As Workbook
    Dim ws3 As Worksheet
    Application.ScreenUpdating = False

    Dim FileName As Variant
    FileName = Application.GetOpenFilename(filefilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm", MultiSelect:=False)

    If FileName = False Then Exit Sub
    Set wb3 = Workbooks.Open(FileName)
    Set ws3 = wb3.Worksheets("QUOTE")
    Set wb2 = Workbooks(FileName)
    Set ws2 = wb2.ActiveSheet

    Dim i As Long
    For i = 19 To 46
        If ws3.Range("D" & i).Value <> "" Then
            ws3.Range("D" & i).Copy
            ws2.Range("S" & i - 18).PasteSpecial xlPasteValues 'Copy as values
            If ws3.Range("D" & i).MergeCells Then
                ws2.Range("S" & i - 18).UnMerge
            End If
        End If
    Next i

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[JoeMo]

thank you Joe, so something like this would be better ?

Sub OpenQuoteFile()
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim wb3 As Workbook
    Dim ws3 As Worksheet
    Application.ScreenUpdating = False

    Dim FileName As Variant
    FileName = Application.GetOpenFilename(filefilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm", MultiSelect:=False)

    If FileName = False Then Exit Sub
    Set wb3 = Workbooks.Open(FileName)
    Set ws3 = wb3.Worksheets("QUOTE")
    Set wb2 = Workbooks(FileName)
    Set ws2 = wb2.ActiveSheet

    Dim i As Long
    For i = 19 To 46
        If ws3.Range("D" & i).Value <> "" Then
            ws3.Range("D" & i).Copy
            ws2.Range("S" & i - 18).PasteSpecial xlPasteValues 'Copy as values
            If ws3.Range("D" & i).MergeCells Then
                ws2.Range("S" & i - 18).UnMerge
            End If
        End If
    Next i

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Not really. That assigns both wb2 and wb3 to the same file - the xlsm file. You said the csv file is already open, so in your original code, set wb2 to Workbooks("csv filename between the quote marks") and set ws2 to wb2.sheets("sheet name between the quotes").

 

[zack8576]

Not really. That assigns both wb2 and wb3 to the same file - the xlsm file. You said the csv file is already open, so in your original code, set wb2 to Workbooks("csv filename between the quote marks") and set ws2 to wb2.sheets("sheet name between the quotes").

thank you Joe. what if I have a bunch of csv files that all have different names. What is the best way to define wb2 then ?

 

[AC PORTA VIA]

Is this what you are looking for

Sub OpenQuoteFile()
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim wb3 As Workbook
    Dim ws3 As Worksheet
    Application.ScreenUpdating = False
    Set wb2 = ActiveWorkbook
    Set ws2 = ActiveSheet
    Dim FileName As Variant
    FileName = Application.GetOpenFilename(filefilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm", MultiSelect:=False)

    If FileName = False Then Exit Sub

    Set wb3 = Workbooks.Open(FileName)
    Set ws3 = Workbooks.Open(FileName).Worksheets("QUOTE")
    
    
    wb2.Activate
    ws2.Activate

    Dim i As Long
    For i = 15 To 20
        If ws3.Range("D" & i).Value <> "" Then
            ws3.Range("D" & i).Copy
            ws2.Range("S" & i - 18).PasteSpecial xlPasteValues 'Copy as values
            If ws3.Range("D" & i).MergeCells Then
                ws2.Range("S" & i - 18).UnMerge
            End If
        End If
    Next i

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[zack8576]

thank you, I got the issue fixed, instead of messing with active workbook, I changed the my approach so instead of just open the xlsm it now opens csv and the xlsm and define them both
below is the working code

Sub OpenQuoteFile()
    Dim csvFilePath As String, xlsmFilePath As String
    
    csvFilePath = Application.GetOpenFilename("CSV Files (*.csv),*.csv")
    If csvFilePath <> "False" Then
        Set wb1 = Workbooks.Open(csvFilePath)
        Set ws1 = wb1.Sheets(1)
    Else
        Exit Sub
    End If
    
    xlsmFilePath = Application.GetOpenFilename("XLSM Files (*.xlsm),*.xlsm")
    If xlsmFilePath <> "False" Then
        Set wb2 = Workbooks.Open(xlsmFilePath)
        Set ws2 = wb2.Sheets("QUOTE")
    Else
        wb1.Close SaveChanges:=False
        Exit Sub
    End If
    
    Dim i As Long
    For i = 19 To 46
        If ws2.Range("D" & i).Value <> "" Then
            ws2.Range("D" & i).Copy
            ws1.Range("S1:S28").NumberFormat = "@"
            ws1.Range("S1:S28").Value = ws2.Range("D19:D46").Value
            If ws2.Range("D" & i).MergeCells Then
                ws1.Range("S" & i - 28).UnMerge
            End If
            ws1.Range("S1:S28").EntireColumn.AutoFit
        End If
    Next i
    For i = 19 To 46
        If ws2.Range("E" & i).Value <> "" Then
            ws2.Range("E" & i).Copy
            ws1.Range("T1:T28").NumberFormat = "@"
            ws1.Range("T1:T28").Value = ws2.Range("E19:E46").Value
            If ws2.Range("E" & i).MergeCells Then
                ws1.Range("T" & i - 28).UnMerge
            End If
            ws1.Range("T1:T28").EntireColumn.AutoFit
        End If
    Next i
    For i = 19 To 46
        If ws2.Range("F" & i).Value <> "" Then
            ws2.Range("F" & i).Copy
            ws1.Range("U1:U28").NumberFormat = "@"
            ws1.Range("U1:U28").Value = ws2.Range("F19:F46").Value
            If ws2.Range("F" & i).MergeCells Then
                ws1.Range("U" & i - 28).UnMerge
            End If
            ws1.Range("U1:U28").EntireColumn.AutoFit
        End If
    Next i
    Application.CutCopyMode = False
    wb2.Close SaveChanges:=False
    Application.ScreenUpdating = True
End Sub