0

I am trying to modify the below code so that it will be able to copy from one workbook to another and paste in the first empty blank cell in column A. For example if I copy and paste from A1 to E18 from one workbook, I want to be able to modify the code so that it opens a second workbook and copies and pastes the code from A19 (the first blank cell in A). I am greener than green when it comes to VBA programming. I have looked at examples for similar situations but have not been able to figure out how to apply them to what I want to do. Thank you!

 Option Explicit

   Sub FreezerLogImport()
   Dim vFile As Variant
   Dim wbCopyTo As Workbook
   Dim wsCopyTo As Worksheet
   Dim wbCopyFrom As Workbook
   Dim wsCopyFrom As Worksheet

   Set wbCopyTo = ActiveWorkbook
   Set wsCopyTo = ActiveSheet


   '-------------------------------------------------------------
 'Open file with data to be copied

     vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
     "*.xl*", 1, "Select Excel File", "Open", False)

  'If Cancel then Exit
      If TypeName(vFile) = "Boolean" Then
           Exit Sub
      Else
    Set wbCopyFrom = Workbooks.Open(vFile)
    Set wsCopyFrom = wbCopyFrom.Worksheets(1)
    End If

'--------------------------------------------------------------


'Copy Range
    wsCopyFrom.Range("A2:A5000").Copy
    wsCopyTo.Range("A2:A5000").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=True, Transpose:=False

    wsCopyFrom.Range("B2:B5000").Copy
    wsCopyTo.Range("B2").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=True, Transpose:=False

            wsCopyFrom.Range("C2:C5000").Copy
    wsCopyTo.Range("C2").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=True, Transpose:=False

            wsCopyFrom.Range("D2:D5000").Copy
    wsCopyTo.Range("D2").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=True, Transpose:=False

            wsCopyFrom.Range("F2:F5000").Copy
    wsCopyTo.Range("E2:E5000").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=True, Transpose:=False

' Turn off Selection of last column

    Application.Selection = False

' Turn off CutCopyMode to prevent Clipboard message pop-up

    Application.CutCopyMode = False

'Close file that was opened
    wbCopyFrom.Close SaveChanges:=False

End Sub

.

Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook
' Finds M. tuberculosis and nontuberculosis mycobacteria and replaces them with MTBC and NTM, respectively.
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim sheet1 As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("M. tuberculosis", "Unidentified nontuberculosis mycobacteria (NTM)")
rplcList = Array("MTBC", "Unidentified NTM")

'Loop through each item in Array lists
  For x = LBound(fndList) To UBound(fndList)
    'Loop through each worksheet in ActiveWorkbook
      For Each sheet1 In ActiveWorkbook.Worksheets
        sheet1.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      Next sheet1

  Next x

End Sub
Wizhi
  • 6,424
  • 4
  • 25
  • 47
  • 2
    [This SO question's accepted answer](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba) will help you find the first unused cell in a column. Presuming you wrote the rest of that code, you should have no problem moving on from there. – FreeMan Nov 07 '18 at 17:13
  • You mentioned you only want to copy from A to E but take note you've got code that mentions column F `wsCopyFrom.Range("F2:F5000").Copy` – Marcucciboy2 Nov 07 '18 at 21:16
  • I am sorry for the confusion. I did say copy from A to E. It should be copy to A to E. The workbooks I copy from use Columns A to F. I skip column E and past F from the one workbook to E on the second work book. To help clarify. I copy column A from workbook 1 to A on workbook 2; B from workbook 1 to B on workbook 2; C from workbook 1 to C on workbook 2, D from workbook 1 to D on workbook 2 and F from workbook 1 to E on workbook 2. – Christian Nov 08 '18 at 16:25
  • Please ignore the coding for Sub Multi_FindReplace(). That was copied and pasted by mistake. – Christian Nov 08 '18 at 16:31
  • I found code that takes you to the first blank cell in a specified column. I verified that the code by itself takes you to the first empty cell in the specified column. When I use it in the current codes I get the following run time error. "Run time error 1004: Unable to get the Select property of the Range class. The code is modified to: wsCopyTo.Range("A2").End(xlDown).Offset(1, 0).Select.PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=True, Transpose:=False – Christian Nov 08 '18 at 18:13

0 Answers0