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