VBA пройти через столбец и скопировать ячейки

Question

Мне удалось написать код, который идет в каждую строку, если есть данные, и скопировать данные в другой файл в определенных ячейках. Теперь я хочу сделать то же самое, но код должен проходить через каждый столбец вместо строки, пока не останется данных.

Мой код для работающих строк:

Sub Row_copying()

 'load my workbooks

Dim Header As Workbook
Workbooks.Open FileName:="/Users/Header.xlsx"
Set Header = Workbooks("Header.xlsx")

Dim samplelist As Workbook
Workbooks.Open FileName:="/Users/samplelist.xlsx"
Set samplelist = Workbooks("samplelist.xlsx")

samplelist.Activate

'Проход по каждой строке, в которой есть данные Dim lRow As Long

For lRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Range("A" & lRow).Value <> "" Then
    'copy cell
    Range("D" & lRow).Copy
    Header.Activate
    Range("K5:M5").Select
    ActiveSheet.Paste

    samplelist.Activate
    Range("H" & lRow).Copy
    Header.Activate
    Range("F5:G5").Select
    ActiveSheet.Paste


Dim DName As String, dataname As String, path As String
        samplelist.Activate
        path = "/Users/newdata/"
        DName = "sample_"
        dataname = path & DName & Format(Range("A") & lRow.Value, "000") & ".xlsx"
        Header.Activate
        ActiveWorkbook.SaveAs FileName:= dataname
End If
samplelist.Activate
Next lRow
Workbooks("samplelist.xlsx").Close
End Sub

Мне удалось проверить, сколько столбцов содержит данные, изменив lRow на

lCol = Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox"last Column: "&lCol

, но я не смогУдостоверьтесь, что он проходит через каждый столбец и скопируйте ячейки. Кто-нибудь может мне помочь?

Answer 1

Вместо того, чтобы использовать Range () для ссылки на ячейки, которые вы проверяете, вы можете использовать ячейки (x, y). Поскольку вы знаете количество строк и столбцов, которые у вас есть, вы можете иметь вложенный элемент For ie For Every Roop Loop All Columns.

Option Explicit

Public Sub sCopy()

  Dim numberOfColumns As Long, numberOfRows As Long
  Dim x As Long, y As Long
  Dim ws As Worksheet

  'set number of rows/columns
  'set workbooks / worksheets

  For x = 1 To numberOfRows
    For y = 1 To numberOfColumns
      If ws.Cells(x, y).Value <> "" Then
       'Do what you have to do
      End If
    Next y
  Next x

End Sub

Answer 2

0

Да, это верно. Извините, что не описал всю мою проблему, потому что теперь я застрял в другом месте. Моя проблема сейчас в том, что адрес ell - один справа, но я хочу, чтобы он шел каждый раз, когда он открывает новый файл одним движком. На данный момент он все еще перезаписывает те же ячейки. Поэтому код не связан с циклом открытия каждый раз нового файла. Я думаю, что мне нужно сделать еще один цикл в моем коде. Код, где он проходит через разные файлы:

path = "/Users/Header/" 
Extension = ".xls" 
Dim strFile As String 
Set dest = Range("B2") 

If path ="" Then 
 Exit Sub 
 Else 
  strFile = Dir(path& Extension) 
  Do While Len(strFile) > 0 ' opens step by step all data in the folder
   ' should I do hear a loop that specify the action for each file?
 Workbooks.Open FileName:= path & strFile
   Range("C3").Copy 
    ' from file that is changing each time, but always value in same cell
   sampleliste.Activate ' sry could not manage to make it run with nicer code
   dest.Select ' this cell should change in column for each new file
   ActiveSheet.Paste
   Workbooks(strFile).Close
   strFile =Dir() ' open next file in folder
Loop 
End If

Каким-то образом я застрял ...

Answer 3

Это список, который я хочу заполнить данными из файлов, которые у меня есть для каждого образца. Я хочу, чтобы данные были заполнены в соответствующем столбце образца. Так что всегда +1 столбец. У меня есть код, который проходит через папку и в каждый файл. Но в приведенном выше коде данные всегда вставляются в одну ячейку и, следовательно, перезаписывают предыдущую.

образец списка, где я хочу обобщить все данные для каждого образца

пример заголовка для каждого из моих образцов