Select range copy paste run macro clear loops till blank column, - vba

Question

I want to copy column A of karai1.xlsx to column A of wipbuj2.xlsx and then run the following macro to copy information to a Word document. Then I want to repeat this by copying column B of karai1.xlsx to column A of wipbuj2.xlsx and run the copy-to Word macro. Then column C of karai1.xlsx, etc, until I reach a blank column. Below is my attempt at copying the first column.
What i need is: copy column from workbook karai1.xlsx paste in workbook wipbuj2.xlsx in A(1st column) run macro/ code following
Dim wdApp As Object
Dim wd As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wd = wdApp.Documents.Add
wdApp.Visible = True
Sheets("Sheet5").Select
Range("A1:g39").Select
Selection.Copy
wdApp.Selection.PasteExcelTable False, False, True
wd.SaveAs
wd.Close
wdApp.Quit
then copy from column 2 from workbook karai1.xlsx paste in wippuj2.xlsx A column run macro run this loop till blank column in sheet karai1.xlsx .
Please help.
this is the code i was working
enter code here
Workbooks.Open Filename:="C:\Users\DO\Desktop\WIP buj 2.xlsx"
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("calculations").Select
Workbooks.Open Filename:= _
"C:\Users\do\Desktop\desktop\karai data\KARAI 1.xlsx"
Range("A1:A177").Select
Selection.Copy
Windows("WIP buj 2.xlsx").Activate
Sheets("calculations").Select
Range("A1").Select
ActiveSheet.Paste
Dim wdApp As Object
Dim wd As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wd = wdApp.Documents.Add
wdApp.Visible = True
Sheets("Sheet5").Select
Range("A1:g39").Select
Selection.Copy
wdApp.Selection.PasteExcelTable False, False, True
wd.SaveAs
wd.Close
wdApp.Quit

Answer 1

I believe by adding a simple loop across each column, stopping when the cell in row 1 is empty, you should be able to achieve what you are after.
Refactored code:
Sub test()
Dim wbSrc As Workbook
Dim wbDst As Workbook
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim wsCpy As Worksheet
Dim c As Long
Dim wdApp As Object
Dim wd As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
wdApp.Visible = True
Set wbDst = Workbooks.Open(Filename:="C:\Users\DO\Desktop\WIP buj 2.xlsx")
Set wsDst = wbDst.Worksheets("calculations")
Set wsCpy = wbDst.Worksheets("Sheet5")
Set wbSrc = Workbooks.Open(Filename:="C:\Users\do\Desktop\desktop\karai data\KARAI 1.xlsx")
Set wsSrc = ActiveSheet ' Would be better to define this explicitly using the sheet name
c = 1
Do While Not IsEmpty(wsSrc.Cells(1, c).Value)
wsSrc.Cells(1, c).Resize(177, 1).Copy wsDst.Range("A1")
'Copy to Word
'Create new document
Set wd = wdApp.Documents.Add
'Copy Excel data
wsCpy.Range("A1:g39").Copy 'Avoid Excel's "Select" whenever possible!
'Paste in Word
wdApp.Selection.PasteExcelTable False, False, True
'Save and close
wd.SaveAs
wd.Close
'Next column
c = c + 1
Loop
wdApp.Quit
End Sub