VBA Copy data into another workbook and paste data into different columns based on cell value

BryanTN

New Member
Joined
Jun 13, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
I made a code to copy data from one workbook to another and although that works I'm stuck on the next step. For the next step I need the data entered in a specific cell to go into a separate worksheet in the opened workbook but it would go into a different column based on the data entered into that cell.

VBA Code:
Dim wb As Workbook, NR As Long
Set copySheet = Worksheets("AUForm")
Set wb = Workbooks.Open("C:\QA\Ryan\Holds_Test\AUDatabase.xlsm")
NR = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row + 1
Set pasteSheet = Worksheets("QCR")
With ThisWorkbook.Sheets("AUForm")
    wb.Sheets("Database").Range("A" & NR).Value = .Range("F21").Value
    wb.Sheets("Database").Range("B" & NR).Value = .Range("F11").Value
    wb.Sheets("Database").Range("C" & NR).Value = .Range("F12").Value
    wb.Sheets("Database").Range("D" & NR).Value = .Range("F13").Value
    wb.Sheets("Database").Range("E" & NR).Value = .Range("F14").Value
    wb.Sheets("Database").Range("F" & NR).Value = .Range("F15").Value
    wb.Sheets("Database").Range("G" & NR).Value = .Range("F16").Value
    wb.Sheets("Database").Range("H" & NR).Value = .Range("F17").Value
    wb.Sheets("Database").Range("I" & NR).Value = .Range("F18").Value
    wb.Sheets("Database").Range("J" & NR).Value = .Range("F19").Value
    wb.Sheets("Database").Range("K" & NR).Value = .Range("F20").Value
    
If ThisWorkbook.Sheets("AUForm").Range("F6") = "AU1" Then
  
    wb.Sheets("QCR").Range("A" & NR).Value = .Range("F21").Value
    
  ElseIf ThisWorkbook.Sheets("AUForm").Range("F6") = "AU2" Then
  
    wb.Sheets("QCR").Range("B" & NR).Value = .Range("F21").Value
    
  ElseIf ThisWorkbook.Sheets("AUForm").Range("F6") = "AU3" Then
  
    wb.Sheets("QCR").Range("C" & NR).Value = .Range("F21").Value
    End If
End With

wb.Close savechanges:=True
 
     Rows("21").EntireRow.Hidden = False
    
        
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
  
End Sub

The first part works and it pastes the data into the other workbook as intended, but I'm stumped at the second half and what I could do to have the data paste into the specific columns on the separate worksheet.
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Since the 2nd part is still under With ThisWorkbook.Sheets("AUForm"), then I suppose this will do on that 2nd part:
VBA Code:
If .Range("F6") = "AU1" Then
    wb.Sheets("QCR").Range("A" & NR).Value = .Range("F21").Value
ElseIf .Range("F6") = "AU2" Then
    wb.Sheets("QCR").Range("B" & NR).Value = .Range("F21").Value
ElseIf .Range("F6") = "AU3" Then
    wb.Sheets("QCR").Range("C" & NR).Value = .Range("F21").Value
End If

Alternatively, you can also do like this
VBA Code:
Select Case .Range("F6")
    Case "AU1"
        wb.Sheets("QCR").Range("A" & NR).Value = .Range("F21").Value
    Case "AU2"
        wb.Sheets("QCR").Range("B" & NR).Value = .Range("F21").Value
    Case "AU3"
        wb.Sheets("QCR").Range("C" & NR).Value = .Range("F21").Value
End Select
 
Upvote 0
Since the 2nd part is still under With ThisWorkbook.Sheets("AUForm"), then I suppose this will do on that 2nd part:
VBA Code:
If .Range("F6") = "AU1" Then
    wb.Sheets("QCR").Range("A" & NR).Value = .Range("F21").Value
ElseIf .Range("F6") = "AU2" Then
    wb.Sheets("QCR").Range("B" & NR).Value = .Range("F21").Value
ElseIf .Range("F6") = "AU3" Then
    wb.Sheets("QCR").Range("C" & NR).Value = .Range("F21").Value
End If

Alternatively, you can also do like this
VBA Code:
Select Case .Range("F6")
    Case "AU1"
        wb.Sheets("QCR").Range("A" & NR).Value = .Range("F21").Value
    Case "AU2"
        wb.Sheets("QCR").Range("B" & NR).Value = .Range("F21").Value
    Case "AU3"
        wb.Sheets("QCR").Range("C" & NR).Value = .Range("F21").Value
End Select
I tried both of these but the data still doesn't show up on the second worksheet. Would I be able to do this outside of the With statement?
 
Upvote 0
It is not about With statement. It is important to ensure range belongs to which sheet.

In your original code:
Rich (BB code):
Dim wb As Workbook, NR As Long
Set copySheet = Worksheets("AUForm")
Set wb = Workbooks.Open("C:\QA\Ryan\Holds_Test\AUDatabase.xlsm")
NR = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row + 1
Set pasteSheet = Worksheets("QCR")
With ThisWorkbook.Sheets("AUForm")
    wb.Sheets("Database").Range("A" & NR).Value = .Range("F21").Value
    wb.Sheets("Database").Range("B" & NR).Value = .Range("F11").Value

You declare but never use copySheet and pasteSheet. This is not a problem.

The statement
Set copySheet = Worksheets("AUForm")
means you defined copySheet refers to ActiveWorkbook.Worksheets("AUForm")

Then after that you execute
Set wb = Workbooks.Open("C:\QA\Ryan\Holds_Test\AUDatabase.xlsm")
By doing so, your ActiveWorkbook is now refers to AUDatabase.xlsm

So unless you Activate any other workbook after that, any line such as
Set pasteSheet = Worksheets("QCR") > Refer to sheet OCR in AUDatabase. Do you have the sheet?

When you have line just like Range("A1"), it will refer to the current Active workbook. No problem if only one workbook opened at that time but if more than one you can get wrong result or error is certain conditions. I have no clear picture ranges mentioned in your code refer to which workbook

See my Sample code which may not work
VBA Code:
Sub Example()

Dim wsAUForm As Worksheet, wsDatabase As Worksheet, wsQCR As Worksheet
Dim wb As Workbook, NR As Long

Set wsAUForm = ActiveWorkbook.Worksheets("AUForm")
Set wb = Workbooks.Open("C:\QA\Ryan\Holds_Test\AUDatabase.xlsm")
Set wsDatabase = wb.Sheets("Database")
Set wsQCR = wb.Sheets("QCR")

NR = wsDatabase.Range("A" & Rows.Count).End(xlUp).Row + 1

wsDatabase.Range("A" & NR).Value = wsAUForm.Range("F21").Value
wsDatabase.Range("B" & NR).Value = wsAUForm.Range("F11").Value
wsDatabase.Range("C" & NR).Value = wsAUForm.Range("F12").Value
wsDatabase.Range("D" & NR).Value = wsAUForm.Range("F13").Value
wsDatabase.Range("E" & NR).Value = wsAUForm.Range("F14").Value
wsDatabase.Range("F" & NR).Value = wsAUForm.Range("F15").Value
wsDatabase.Range("G" & NR).Value = wsAUForm.Range("F16").Value
wsDatabase.Range("H" & NR).Value = wsAUForm.Range("F17").Value
wsDatabase.Range("I" & NR).Value = wsAUForm.Range("F18").Value
wsDatabase.Range("J" & NR).Value = wsAUForm.Range("F19").Value
wsDatabase.Range("K" & NR).Value = wsAUForm.Range("F20").Value
    
Select Case wsAUForm.Range("F6")
    Case "AU1"
        wsQCR.Range("A" & NR).Value = wsAUForm.Range("F21").Value
    Case "AU2"
        wsQCR.Range("B" & NR).Value = wsAUForm.Range("F21").Value
    Case "AU3"
        wsQCR.Range("C" & NR).Value = wsAUForm.Range("F21").Value
End Select

wb.Close savechanges:=True
Rows("21").EntireRow.Hidden = False

Application.ScreenUpdating = True
  
End Sub

It is better you put complete reference like example above. My code probably refers to wrong workbook. So, make necessary modification. The line
Rows("21").EntireRow.Hidden = False
also need to modify because Rows("21") has no specific reference.

I believe you undertand what I am trying to say here and find out what cause the problem.
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

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